1

I'm trying to figure out how to search multiple occurrences of an array for common values using RPGLE, and so far have been unsuccessful. What I'm trying to do, is find out how many arrays share the same common values. Each array is 1 long, with an array length up to 100. For example:

Array 1 = 'a' 'b' 'c' 'd' 'e' 'f' ' ' ' '.....
Array 2 = 'a' 'b' 'c' 'd' 'e' 'g' ' ' ' '.....
Array 3 = 'd' 'c' 'a' 'b' 'h' 'e' ' ' ' '.....
Array 4 = 'k' 'b' 'e' 'd' 'a' 'g' ' ' ' '.....

I'm trying to find an easy way to determine that the letters a, b, d, & e are all common between the arrays, or each of those letters are shared between the arrays.

Does anyone have any idea how to do this search easily, so I don't have to end up in nested do's and if's hell? It gets pretty hairy when all 100 elements of an array are filled out. However, some good news is that there are only 10 arrays that can be filled out.

Thanks in advance!

user1420914
  • 279
  • 1
  • 4
  • 16
  • Well, this is actually a one off scrub program. I have many thousands of records values, and have to find out what records have common characters, and mark them for deletion. am getting more and more used to the idea that I may have to do the nested IF stuff. I'm going to sleep tonight and see if a miracle happens by morning before I tackle it. :) – user1420914 Dec 09 '20 at 02:03
  • As usual, I was thinking too much about the problem and not the solution. These records are grouped, with a blank separating each group. I occurred to me I could put the first record into an array, and check the next records from the group for each character from the first group. So, if "a" was in the first group, but no records from any of the other records in the group, it failed. So just a few %lookup statement while looping over the first group. I'm sure that's clear as mud, but I figured out a way through. :) I am planning on researching the original issue I as asking about. :) – user1420914 Dec 09 '20 at 04:05

2 Answers2

3

Well the good news is that if you're on 7.3 or 7.4, IBM just released some RPG enhancements including a FOR-EACH opcode and a %LIST() bif

Bad news, I don't think those would be a magic wand...

Are you looking for only the values that are common to all 10 arrays?

RPG doesn't have an INTERSECTION operator...but SQL does.

I'd consider building 10 comma separated strings
'a,b,c,d,e,f,...' to pass to the Db. Then make use of the SPLIT() SQL function (also in 7.3 and 7.4) to split each string into a set of records that you could request the INTERSECTION of.

If I have some more time later, I'll try and post some code.

An RPG only solution is an interesting challenge ...

Charles
  • 21,637
  • 1
  • 20
  • 44
2

here is a procedure that is a little bit general purpose. It takes an array of 256 char varying strings and an array of patterns to match against that array. Returns '1' or '1' depending on if all the pattern items exist in the input array.

** ------------------------ arr_containsAllArr -------------------
** check that inArr contains all the items in inPatternArr.
parr_containsAllArr...
p                 b
darr_containsAllArr...
d                 pi             1a
d inArr                        256a   const varying dim(100)
d inPatternArr                 256a   const varying dim(100)

d ix              s             10i 0
d fx              s             10i 0
d mx              s             10i 0
d doesContain     s              1a
d patternItem     s            256a   varying
 /free
      doesContain = '1' ;

  // for each patternArr item
      for         ix = 1 to 100 ;
      patternItem = inPatternArr(ix) ;
      if          %len(patternItem) > 0 ;
      fx          = %lookup( patternItem: inArr ) ;
      if          fx = 0 ;
      doesContain = '0' ;
      leave ;
      endif ;
      endif ;
      endfor ;

      return      doesContain ;
 /end-free
p                 e

code shows how the procedure is use:

d arr             s            256a   varying dim(100)
d patternArr      s            256a   varying dim(100)
d doesContain     s              1a
 /free
      clear       arr ;
      clear       patternArr ;
      arr(1)      = 'z' ;
      arr(2)      = 'a' ;
      arr(3)      = 'w' ;
      arr(4)      = 'm' ;
      patternArr(1)  = 'w' ;
      patternArr(2)  = 'd' ;
      patternArr(3)  = 'z' ;
      doesContain = arr_containsAllArr( arr: patternArr ) ;
      if          doesContain = '1' ;
      sendInfoMsg( 'does contain all items': 1 ) ;
      else ;
      sendInfoMsg( 'does not contain all items': 1 ) ;
      endif ;

  // contains 'm', 'z' and 'a'
      clear       patternArr ;
      patternArr(1)  = 'm' ;
      patternArr(2)  = 'a' ;
      patternArr(3)  = 'z' ;
      doesContain = arr_containsAllArr( arr: patternArr ) ;
      if          doesContain = '1' ;
      sendInfoMsg( 'does contain all items': 1 ) ;
      else ;
      sendInfoMsg( 'does not contain all items': 1 ) ;
      endif ;
 /end-free

** ----------------------- pr_Qmhsndpm -------------------------------
dpr_Qmhsndpm      pr                  extpgm('QMHSNDPM')
d InMsgid                        7a   const
d InMsgf                        20a   const
d InMsgData                  32767a   const options(*VarSize)
d InMsgDatal                    10i 0 const
d InMsgType                     10a   const
d InCsEntry                    256a   const options(*VarSize)
d InCsCounter                   10i 0 const
d OutMsgKey                      4a
d OutError                            likeds(zApiError )
d InCsEntryLx                   10i 0 const options(*NoPass)
d InCsQual                      20a   const options(*NoPass)
d InWaitTime                    10i 0 const options(*NoPass)

** ---------------------- zApiError ----------------------------
** zApiError - the ERRC0100 struct filled by system api calls.
dzApiError        ds                  qualified
d size                          10i 0 inz(%size(zApiError))
d BytesNeeded                   10i 0
d ExcpId                         7a
d Rsv1                           1a
d ExcpData                    2048a

** ---------------------- sendInfoMsg ---------------------------
psendInfoMsg...
p                 b                   export
dsendInfoMsg...
d                 pi
D InText                      2000    const varying
D InCallStackCx                 10i 0 Value options(*nopass)

d err             ds                  likeds(zApiError)
D Msgf            S             20a
d msgid           s              7a
d msgData         s           2000a
d msgDataLx       s             10i 0
D msgkey          S              4a
d MsgText         s           2000a
d msgType         s             20a
d callStackCx     s             10i 0
 /free
      Msgf        = 'QCPFMSG   *LIBL' ;
      msgid       = 'CPF9898' ;
      msgdata     = inText ;
      msgdataLx   = %len(%trimr(msgdata)) ;
      msgType     = '*INFO' ;
      callStackCx = 2 ;
      if          %parms >= 2 ;
      callStackCx += inCallStackCx ;
      endif ;
      msgkey      = ' ' ;
      err.size    = %size(err) ;
      err.BytesNeeded = 0 ;
      pr_qmhsndpm( msgId: msgf: msgData: msgDataLx: msgType:
                   '*': callStackCx: MsgKey: err ) ;

 /end-free
p                 e
RockBoro
  • 2,163
  • 2
  • 18
  • 34
  • They, that's pretty cool! It doesn't satisfy all of the requirements I'm coming up with, but I can definitely see that I could modify this to make it work. Thanks! – user1420914 Dec 09 '20 at 19:06
  • arrays are very limited in RPG. I kind of remember lookup as expecting the array to be sorted. But looks like it works in this case. Just something to keep in mind. – RockBoro Dec 10 '20 at 00:28
  • Yeah, tell me about it. I have done some pretty neat things with arrays in RPG, but this one was pretty much over the top....I had to change it for my needs, but the code above works just fine! – user1420914 Dec 10 '20 at 13:39