Topic
  • No replies
iCoderSmit
iCoderSmit
1 Post

Pinned topic Levenshtein Distance in RPG Free

‏2018-03-08T18:39:26Z | comparison dissimilarity distance levenshtein rpg score similarity string

Hi, 

I have recently written code in free format RPG for calculating Levenshtein Distance b/w 2 given strings. This is the code of Service Program that I wrote. Hope this helps if someone is looking for a solution to find the percentage match between two strings.

Prototype:

 /if defined(LEVENSHTN_pr)
     d ds1Retn         ds                  inz
     d  d1LevDist                     9  0

     d LEVENSHTN       pr                  likeds(ds1Retn)
      /undefine LEVENSHTN_pr
      /endif

      /if defined(LEVENSHTN_pi)
     d LEVENSHTN       pi                  likeds(ds1Retn)
      /undefine LEVENSHTN_pi
      /endif

     d p@Source                     100    const
     d p@Target                     100    const     

 

Service Program:

/Define LEVENSHTN_pr
V001  /copy Qprototype,LEVENSHTN
      **********************************************************************
V001 p LEVENSHTN       b                   export

V001  /Define LEVENSHTN_pi
V001  /copy Qprototype,LEVENSHTN

      **********************************************************************
     d w@Curdt7        s              7  0 inz(0)
V001 d w@IsoDate       s               D   DatFmt(*ISO)
V001 d w@TodayUSA      s               D   DatFmt(*USA)
V001  *
V001 d SqlStm          s           1024    inz
V001 d tck             c                   const(x'7D')
V001 d w@Index         s              4  0 inz
V001 d validchars      c                   CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ-
V001 d                                     01234567890')
V001 d up              c                   const('ABCDEFGHIJKLMNOPQRST-
V001 d                                     UVWXYZ')
V001 d lo              c                   const('abcdefghijklmnopqrst-
V001 d                                     uvwxyz')
V001  *
V001 d matrix          ds                  dim(100) qualified
V001 d  idx                           4p 0 dim(100)
V001  *
V001 d i               s              4  0 inz
V001 d j               s              4  0 inz
V001  *
V001 d s_i             s              1    inz
V001 d t_j             s              1    inz
V001  *
V001 d n               s              4  0 inz
V001 d m               s              4  0 inz
V001 d w@Source        s            100    inz
V001 d w@Target        s            100    inz
V001  *
V001 d w@Cost          s              1  0 inz
V001 d w@Above1        s              4  0 inz
V001 d w@Left1         s              4  0 inz
V001 d w@DiagCost      s              4  0 inz
V001 d w@MinVal        s              4  0 inz
V001  *
V001 d w@SplPos        s              4  0 inz
V001 d w@SplChar       s              1    inz
      **********************************************************************
      /Free
V001
V001   clear ds1Retn;

V001   exSr sMain;
V001
V001   return ds1Retn;
V001
V001   //------Main Subroutine------//
V001   BegSr sMain;
V001
V001     //Validate Parameters
V001     if p@Source = *Blanks or p@Target = *Blanks;
V001       leaveSr;
V001     endif;
V001
V001     w@Source = p@Source;
V001     w@Target = p@Target;
V001
V001     n = %len(%trim(w@Source));
V001     m = %len(%trim(w@Target));
V001
V001     if n = 0 or m = 0;
V001       d1LevDist = 999999999;  //Indicates at least one string is blank
V001       leaveSr;
V001     endif;
V001
V001     if n = m and %trim(w@Source) = %trim(w@Target); //Strings are same
V001       d1LevDist = n;
V001       leaveSr;
V001     endif;
V001
V001     //Set both source and target strings to upper case
V001     w@Source = %xlate(lo:up:w@Source);
V001     w@Target = %xlate(lo:up:w@Target);
V001
V001     //Remove special characters from both source and target strings
V001     clear w@SplPos;
V001     clear w@SplChar;
V001     dou %check(validchars:%trim(w@Source)) = 0;
V001       w@SplPos = %check(validchars:%trim(w@Source));
V001       if w@SplPos > 0;
V001         w@Source = %subst(w@Source:1:(w@SplPos-1)) +
V001               %subst(w@Source:(w@SplPos+1));
V001       else;
V001         leave;
V001       endif;
V001     enddo;
V001     dou %check(validchars:%trim(w@Target)) = 0;
V001       w@SplPos = %check(validchars:%trim(w@Target));
V001       if w@SplPos > 0;
V001         w@Target = %subst(w@Target:1:(w@SplPos-1)) +
V001               %subst(w@Target:(w@SplPos+1));
V001       else;
V001         leave;
V001       endif;
V001     enddo;
V001
V001     //Recalculate lengths of cleaned up strings
V001     n = %len(%trim(w@Source));
V001     m = %len(%trim(w@Target));
V001
V001     //Calculate Levenshtein Distance based on cleaned up strings
V001
V001     //Step 1 - Initialize 1st row for source string
V001     for i = 1 by 1 to (n + 1);
V001       matrix(1).idx(i) = i - 1;
V001     endfor;
V001
V001     //Step 2 - Initialize 1st column for target string
V001     for j = 1 by 1 to (m + 1);
V001       matrix(j).idx(1) = j - 1;
V001     endfor;
V001
V001     //Step 3 - Start calculating distances
V001     for i = 2 by 1 to (n + 1);
V001
V001       s_i = %subst(%trim(w@Source):(i-1):1);
V001
V001       for j = 2 by 1 to (m + 1);
V001
V001         t_j = %subst(%trim(w@Target):(j-1):1);
V001
V001         if (s_i = t_j);
V001           w@Cost = 0;
V001         else;
V001           w@Cost = 1;
V001         endif;
V001
V001         clear w@Above1;
V001         clear w@Left1;
V001         clear w@DiagCost;
V001
V001         clear w@MinVal;
V001
V001         w@Above1    = matrix(j-1).idx(i) + 1;
V001         w@Left1     = matrix(j).idx(i-1) + 1;
V001         w@DiagCost  = matrix(j-1).idx(i-1) + w@Cost;
V001
V001         w@MinVal = w@Above1;
V001         if (w@Left1 < w@MinVal);
V001           w@MinVal = w@Left1;
V001         endif;
V001         if (w@DiagCost < w@MinVal);
V001           w@MinVal = w@DiagCost;
V001         endif;
V001
V001         matrix(j).idx(i) = w@MinVal;
V001
V001       endfor;
V001
V001     endfor;
V001
V001     d1LevDist = matrix(m + 1).idx(n + 1);
V001
V001   EndSr;
V001
      /End-Free
V001 p LEVENSHTN       e

 

Updated on 2018-03-08T20:20:47Z at 2018-03-08T20:20:47Z by iCoderSmit