home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / NFSRC.ZIP / AADING.PRG < prev    next >
Encoding:
Text File  |  1991-08-16  |  4.7 KB  |  167 lines
  1. /*
  2.  * File......: Aadding.prg
  3.  * Author....: Ralph Oliver,  TRANSCOM SYSTEMS
  4.  * CIS ID....: 74030,703
  5.  * Date......: $Date:   15 Aug 1991 23:05:40  $
  6.  * Revision..: $Revision:   1.1  $
  7.  * Log file..: $Logfile:   E:/nanfor/src/aading.prv  $
  8.  * 
  9.  * This is an original work by Ralph Oliver and is placed in the
  10.  * public domain.
  11.  *
  12.  * Modification history:
  13.  * ---------------------
  14.  *
  15.  * $Log:   E:/nanfor/src/aading.prv  $
  16.  * 
  17.  *    Rev 1.1   15 Aug 1991 23:05:40   GLENN
  18.  * Forest Belt proofread/edited/cleaned up doc
  19.  * 
  20.  *    Rev 1.0   07 Jun 1991 23:03:08   GLENN
  21.  * Initial revision.
  22.  *
  23.  *
  24.  */
  25.  
  26.  
  27. /*  $DOC$
  28.  *  $FUNCNAME$
  29.  *     FT_AADDITION()
  30.  *  $CATEGORY$
  31.  *     Array
  32.  *  $ONELINER$
  33.  *     Add elements unique of source array to target array
  34.  *  $SYNTAX$
  35.  *     FT_AADDITION( <aList1>, <aList2> [, <lTrimmer> [, <lCaseSens> ] ] ) ;
  36.  *             -> aNewArray
  37.  *  $ARGUMENTS$
  38.  *     <aList1> is the primary array.
  39.  *
  40.  *     <aList2> is the secondary array.
  41.  *
  42.  *     <lTrimmer> is a logical value denoting whether leading or
  43.  *             trailing spaces should be included in the
  44.  *             comparison. If .T., then ignores spaces in
  45.  *             comparison, defaults to .T., .F. includes spaces.
  46.  *
  47.  *     <lCaseSens> is a logical value denoting case sensitivity.
  48.  *             If .T., then comparison is sensitive to case,
  49.  *             defaults to .T., .F. ignores case.
  50.  *  $RETURNS$
  51.  *     An array of the union of aList1 and aList2.
  52.  *  $DESCRIPTION$
  53.  *     This function will add the elements unique of aList2 with aList1.
  54.  *     It returns a new array including all the elements of aList1
  55.  *     plus the unique elements of aList2.
  56.  *  $EXAMPLES$
  57.  *     aList1 := {"apple", "orange", "pear"}
  58.  *     aList2 := {"apple ", "banana", "PEAR"}
  59.  *
  60.  *     FT_AADDITION( aList1, aList2 )
  61.  *          // ignores spaces, sensitive to case
  62.  *          // returns {"apple","orange","pear","banana","PEAR"}
  63.  *
  64.  *     FT_AADDITION( aList1, aList2, , .F. )
  65.  *          // ignores spaces, not sensitive to case
  66.  *          // returns {"apple","orange","pear","banana"}
  67.  *
  68.  *     FT_AADDITION( aList1, aList2, .F., .F. )
  69.  *          // sensitive to spaces, not sensitive to case
  70.  *          // returns {"apple","orange","pear","apple ","banana"}
  71.  *  $END$
  72.  */
  73.  
  74. #ifdef FT_TEST
  75.  
  76. FUNCTION MAIN()
  77.    LOCAL aList1,aList2,var0,nstart,nstop,nelapsed,nCtr
  78.    CLS
  79.    ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AADDITION"
  80.    ?
  81.    aList1 := {"apple", "orange", "pear"}
  82.    aList2 := {"apple ", "banana", "PEAR"}
  83.    ? "aList1 : "
  84.    AEVAL( aList1, { |x| QQOUT(x + ",") } )
  85.    ?
  86.    ? "aList2 : "
  87.    AEVAL( aList2, { |x| QQOUT(x + ",") } )
  88.    ?
  89.  
  90.    nstart := SECONDS()
  91.    FOR nCtr := 1 to 100
  92.       var0 := FT_AADDITION( aList1, aList2 )
  93.    NEXT
  94.    nstop := SECONDS()
  95.    nelapsed := nstop - nstart
  96.    ? "time for 100 merges:", nelapsed
  97.  
  98.    ? PADR("FT_AADDITION( aList1, aList2 ) ->",44)
  99.    AEVAL( var0, { |x| QQOUT(x + ",") } )
  100.    ?
  101.    var0 := FT_AADDITION( aList1, aList2, , .F. )
  102.    ? PADR("FT_AADDITION( aList1, aList2, , .F. ) ->",44)
  103.    AEVAL( var0, { |x| QQOUT(x + ",") } )
  104.    ?
  105.    var0 := FT_AADDITION( aList1, aList2, .F., .F. )
  106.    ? PADR("FT_AADDITION( aList1, aList2, .F., .F. ) ->",44)
  107.    AEVAL( var0, { |x| QQOUT(x + ",") } )
  108.    ?
  109.    RETURN NIL
  110.  
  111. #endif
  112.  
  113.  
  114. FUNCTION FT_AADDITION( aList1, aList2, lTrimmer, lCaseSens )
  115.  
  116.    LOCAL nElement, nPos, bScanCode
  117.    LOCAL aNewArray := ACLONE( aList1 )
  118.  
  119.    // Set default parameters as necessary.
  120.    IF lCaseSens == NIL
  121.       lCaseSens := .T.
  122.    ENDIF
  123.  
  124.    IF lTrimmer == NIL
  125.       lTrimmer := .T.
  126.    ENDIF
  127.  
  128.    // Assign code blocks according to case sensitivity and trim.
  129.    IF lCaseSens
  130.  
  131.       IF lTrimmer                         // Ignore spaces.
  132.          bScanCode := { |x| ;
  133.                         ALLTRIM( x ) == ;
  134.                         ALLTRIM( aList2[ nElement ]) }
  135.       ELSE
  136.          bScanCode := { |x| ( aList2[ nElement ]) }
  137.       ENDIF
  138.  
  139.    ELSE                                   // Ignore case.
  140.  
  141.       IF lTrimmer                         // Ignore spaces.
  142.          bScanCode := { |x| ;
  143.                         UPPER( ALLTRIM( x )) == ;
  144.                         UPPER( ALLTRIM( aList2[ nElement ] )) }
  145.       ELSE
  146.          bScanCode := { |x| ;
  147.                         UPPER( x ) == ;
  148.                         UPPER( aList2[ nElement ] ) }
  149.       ENDIF
  150.    ENDIF
  151.  
  152.  
  153.    // Add the unique elements of aList2 to aList1.
  154.    FOR nElement := 1 TO LEN( aList2 )
  155.  
  156.       nPos := ASCAN( aList1, bScanCode )
  157.  
  158.       // If unique, then add element to new array.
  159.       IF nPos = 0
  160.          AADD( aNewArray, aList2[ nElement ] )
  161.       ENDIF
  162.  
  163.    NEXT
  164.  
  165.    RETURN ( aNewArray )
  166.  
  167.