I 系列 RPGLE 在多个数组中搜索公共值

Question

我试图弄清楚如何使用 RPGLE 在数组的多次出现中搜索常见值，但到目前为止一直没有成功。我想要做的是找出有多少数组共享相同的共同值。每个数组长度为 1，数组长度最大为 100。例如：

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' ' ' ' '.....

我试图找到一种简单的方法来确定字母 a、b、d 和 e 在数组之间都是通用的，或者这些字母中的每一个在数组之间都是共享的。

有没有人知道如何轻松地进行此搜索，这样我就不必陷入嵌套的do's and if's hell？当一个数组的所有 100 个元素都被填满时，它会变得非常棘手。不过，好消息是，可以填写的数组只有 10 个。

提前致谢！

Answer 1

好消息是，如果您使用的是 7.3 或 7.4，IBM 刚刚发布了一些 RPG enhancements，包括 FOR-EACH 操作码和 %LIST() bif

坏消息，我不认为那是一根魔杖......

您是否只查找所有 10 个数组共有的值？

RPG 没有 INTERSECTION 运算符...但 SQL 有。

我会考虑构建 10 个逗号分隔的字符串
'a,b,c,d,e,f,...' 传递给 Db。然后使用SPLIT() SQL 函数（也在 7.3 和 7.4 中）将每个字符串拆分为一组记录，您可以请求它们的 INTERSECTION。

如果我以后有更多时间，我会尝试发布一些代码。

仅 RPG 的解决方案是一个有趣的挑战 ...

Answer 2

这是一个有点通用的过程。它需要一个包含 256 个字符的可变字符串数组和一个模式数组来匹配该数组。根据输入数组中是否存在所有模式项，返回“1”或“1”。

** ------------------------ 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

代码显示了如何使用该过程：

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