IC SunsetThe developerWorks Connections Platform is now in read-only mode and content is only available for viewing. No new wiki pages, posts, or messages may be added. Please see our FAQ for more information. The developerWorks Connections platform will officially shut down on March 31, 2020 and content will no longer be available. More details available on our FAQ. (Read in Japanese.)
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