Extended Multivalued Operations in R/BASIC

Because of the unique capabilities of multivalued fields in Advanced Revelation, R/BASIC includes a set of "multivalue operators" that parallel those used for single values. For example, the operator for multiplication ("*") has an equivalent operator for use with multivalued fields ("***").

However, there are some limitations in the implementation of multivalue operators. This technical bulletin illustrates a function you can create that extends the capabilities of these operators to accommodate most requirements.

The multivalue operators apply one operation (for example, multiplication) to two multivalued fields (arrays delimited with ASCII characters 253s). The result is another multivalued field, one that contains the results of the operation.

A typical example is one like that in the Sample Application (Advanced Revelation 2.0+), an invoice record in which you have the two multivalued fields QTY and PRICE. To create an extension price, you would multiply quantity by price, but because both of these fields are multivalued, you must use multivalue operators for a formula like this one:

@ANS = {QTY} *** {PRICE}

The result placed in @ANS will also be a multivalued array.

When you perform a multivalue operation of this type against two arrays, R/BASIC loops through both arrays, extracting the next element of both, and applying the appropriate operation (in the example, multiplication). If the two arrays looked something like this:

1  ,  2,  1 ***
100,200,300

The end result would be an array like this:

100,400,300

A limitation of multivalue operators is that they do not "distribute" values when you apply them to arrays of differing lengths. Using the illustration above, consider how the multivalue operators handle multiplying two arrays with different lengths:

1,    2     ***
100,200,300
-----------
100,200,0

The last value in the second array, 300, has no corresponding value in the first array, so the multivalue operation (multiplication) simply assumes a zero. The system assumes that the missing data is missing for a reason. This protects you against unintended side effects.

The most common version of this scenario occurs when you are attempting to multiply a multivalued array by a single value. This is useful, for example, if you wish to apply a single change or discount to an array of prices. To multiply each element in the QTY field by 1.1, for instance, you cannot simply use the formula {QTY}***1.1, because for every value but the first one in the QTY field, the results array will contain a zero.

Figure 1 illustrates the R/BASIC code for a function that can perform operations against multivalue arrays of unequal lengths. The function has these capabilities:

• Distribute a single value against a multivalue array.
• Distribute a shorter array against a longer one.
• Pad a shorter array with a user-specified character to make it as long as the second array.

Using the schematic method from above, the following illustrates the capabilities:

100,200,300 ***
1.1
-----------
110,220,330

C,D,E,F,G,H :::
A,B
-----------
CA,DB,EA,FB,GA,HB

C,D,E,F :::
A,(*)
-------
CA,D*,E*,F*

To use the program, use this syntax:

DECLARE FUNCTION MVMATH
@ANS = MVMATH({PRICE},"1.1","*","*")

Explanations of the parameters are provided in the code.

MVMATH

FUNCTION MVMATH(A1, A2, OP, PAD)
/*
This is a general routine to do MV math on arrays of different sizes.
Arguments:
----------
A1  First array - @VM delimited
A2  Second array - @VM delimited
OP  The operation to be performed (+, - , * , /, :). If an invalid
    operator is passed, the function returns null.
PAD The default character(s) used to pad the shorter array, if
    applicable. These default values are used if PAD is not supplied or
    is invalid:

    + = 0
    - = 0
    * = 1
    / = 1
    : = "" (null)

    If the wildcard character "*" is passed, the entire shorter
    array is used distributively against the longer array. If the
    characters "**" are used, the "*" is used as the pad (for
    concantenation only).
*/


EQU OPS$       TO "+-*/:"
EQU PADS$      TO "0011"
EQU NULL$      TO ""
EQU TRUE$      TO 1
EQU FALSE$     TO 0
EQU OTHERWISE$ TO 1

DECLARE FUNCTION UNASSIGNED

* Calculate default pad character for current operator
POS         = INDEX(OPS$, OP, 1)
DEFAULT_PAD = PADS$[POS,1]

* Copy arrays (so as not to corrupt originals in calling program)
ARRAY1 = A1
ARRAY2 = A2
ANS    = NULL$ ;* Return value

* Which array is longer?
CNT1 = COUNT(ARRAY1, @VM) + (ARRAY1 NE NULL$)
CNT2 = COUNT(ARRAY2, @VM) + (ARRAY2 NE NULL$)
IF CNT1 NE CNT2 THEN
  DIFF  = ABS(CNT2 - CNT1)
  SHORT = NULL$
  IF CNT1 < CNT2 THEN
    TRANSFER CNT1 TO CNT
    TRANSFER ARRAY1 TO SHORT
    GOSUB PAD
    TRANSFER SHORT TO ARRAY1
  END ELSE
    TRANSFER CNT2 TO CNT
    TRANSFER ARRAY2 TO SHORT
    GOSUB PAD
    TRANSFER SHORT TO ARRAY2
  END
END

* Do the math
BEGIN CASE
  CASE OP = "+"
    ANS = ARRAY 1 +++ ARRAY2
  CASE OP = "-"
    ANS = ARRAY1 --- ARRAY2
  CASE OP = "*"
    ANS = ARRAY1 *** ARRAY2
  CASE OP = "/"
    ANS = ARRAY1 /// ARRAY2
  CASE OP = ":"
    ANS = ARRAY1 ::: ARRAY2
  CASE OTHERWISE$
    ANS = NULL$
END CASE

RETURN ANS
/***********************************************************************
INTERNAL SUBROUTINES
***********************************************************************/

PAD:

ARRAY_PAD = FALSE$ ;* Flag used to see if pad is an array

* If no pad specified, use default value
IF PAD = NULL$ OR UNASSIGNED(PAD) THEN
  PAD = DEFAULT_PAD
END ELSE
  * "*" is wildcard character meaning distribute short array
  IF PAD = "*" THEN
    PAD = SHORT
  END
  IF INDEX(SHORT, @VM, 1) THEN
    * pad value is an array
    ARRAY_PAD = TRUE$
  END
  /*
  "**" is self-escapeing value meaning pad char = "*", (for concat only)
  */
  IF OP = ":" THEN
    IF PAD = "**" THEN
      PAD = "*"
    END
  END ELSE
    * check for valid numeric pad, override with default if not
    * numeric
    IF ARRAY_PAD THEN
      FOR CNTR = 1 TO CNT
         IF NUM(SHORT<1,CNTR>) ELSE
           SHORT<1,CNTR> = DEFAULT_PAD
         END
      NEXT CNTR
    END ELSE
      IF NUM(PAD) ELSE
        PAD = DEFAULT_PAD
      END
    END
  END
END

* create pad, add to short array

IF ARRAY_PAD THEN
  /*
  If pad is mv array, concatenate onto short array until it reaches value
  count of the longer array.
  */
  LONG_CNT = CNT + DIFF
  SHORT_CNT = CNT
  LOOP
    SHORT := @VM : PAD
    SHORT_CNT += CNT
  UNTIL SHORT_CNT >= LONG_CNT
  REPEAT

  * adjust if it got to be longer than the long array
  IF SHORT_CNT > LONG_CNT THEN
    SHORT = FIELD(SHORT, @VM, 1, LONG_CNT)
  END
END ELSE
  * single character pad
  PAD = STR(@VM : PAD, DIFF)
  SHORT := PAD
END
RETURN