home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR502.DOS / SOURCE / SAMPLE / DICT.PRG < prev    next >
Encoding:
Text File  |  1993-02-15  |  6.0 KB  |  261 lines
  1. /***
  2. *
  3. *    Dict.prg
  4. *
  5. *    Keyed dictionary utility.
  6. *
  7. *  Copyright (c) 1993, Computer Associates International Inc.
  8. *  All rights reserved.
  9. *
  10. *    Uses an array to contain list of "dictionary" entries.
  11. *    Each entry consists of a character key and a value of any type.
  12. *    New keys and values can be entered, and existing values can be
  13. *    retrieved based on their key.
  14. *
  15. *
  16. *  Index of functions contained in Dict.prg (this file):
  17. *  -----------------------------------------------------
  18. *
  19. *  DictNew() --> <aDictionary>
  20. *
  21. *     Creates and returns an empty dictionary.
  22. *
  23. *
  24. *  DictAt( <aDictionary>, <cKey> ) --> <xValue>
  25. *
  26. *     Returns the <xValue> associated with <cKey> in dictionary,
  27. *     NIL if <cKey> is not present in dictionary.
  28. *
  29. *
  30. *  DictPut( <aDictionary>, <cKey>, <xValue> ) --> <xValue>
  31. *
  32. *     Associates <cKey> to <xValue> in <aDictionary>. Returns
  33. *        <xValue>.
  34. *
  35. *
  36. *  DictPutPair( <aDictionary>, <aPair> ) --> <aPair>
  37. *
  38. *        Adds <aPair> to <aDictionary>. Returns <aPair>.
  39. *     <aPair> is a <cKey>/<xValue> pair: { <cKey>, <xValue> }.
  40. *
  41. *
  42. *  DictRemove( <aDictionary>, <cKey> ) --> <aDictionary>
  43. *
  44. *     Removes the <cKey>/<xValue> pair for <cKey>.
  45. *        Returns <aDictionary>.
  46. *
  47. *
  48. *  DictEval( <aDictionary>, <bBlock> ) --> <aDictionary>
  49. *
  50. *        Evaluates <bBlock> against each <cKey>/<xValue> pair in
  51. *        dictionary. Pair is passed to block as { <cKey>, <xValue> }
  52. *     (pair array indexes defined in "Dict.ch").
  53. *        Returns <aDictionary>.
  54. *
  55. *
  56. *  NOTES:
  57. *     Compile with /a /m /n /w
  58. *
  59. *     Key values must all be of type 'C' (character), case is significant.
  60. *
  61. *        These dictionaries are useful if you want to keep a list
  62. *        of keyed values without using a database. Since they're
  63. *     arrays, you can hang onto them with any variable or
  64. *        array element (handy for keeping track of multiple "cargo"
  65. *        items, for example). If you have lots of values, though,
  66. *        a database/index is usually more appropriate.
  67. *
  68. */
  69.  
  70. #include "Dict.ch"
  71.  
  72.  
  73. // Hash machinery
  74. #define KEY_HASH( key )       ( BIN2W( key ) + BIN2W( SUBSTR(TRIM( key ), -2 )))
  75. #define HASH_VAL( key, size ) ( ( KEY_HASH( key ) % size ) + 1 )
  76.  
  77. #define DEFAULT_HASH_SIZE        31
  78. #define MAX_ARRAY_LEN            4096
  79.  
  80.  
  81.  
  82. /***
  83. *
  84. *  DictNew() --> aDictionary
  85. *
  86. *  Create a new, empty dictionary
  87. *
  88. */
  89. FUNCTION DictNew()
  90.  
  91.     LOCAL i
  92.    LOCAL aDict
  93.  
  94.    aDict := ARRAY( DEFAULT_HASH_SIZE )
  95.  
  96.    FOR i := 1 TO DEFAULT_HASH_SIZE
  97.       aDict[i] := {}
  98.     NEXT
  99.  
  100.    RETURN ( aDict )
  101.  
  102.  
  103.  
  104. /***
  105. *
  106. *  DictAt( <aDict>, <cKey> ) --> xValue
  107. *
  108. *  Return the value for a particular key
  109. *
  110. */
  111. FUNCTION DictAt( aDict, cKey )
  112.  
  113.    LOCAL aBucket     // Array that contains the key/value pair
  114.    LOCAL nPairNo     // Location of the matching pair, zero if none matches
  115.  
  116.    aBucket := aDict[ HASH_VAL( cKey, LEN( aDict )) ]
  117.    nPairNo := ASCAN( aBucket, { |aPair| aPair[DI_KEY] == cKey } )
  118.  
  119.    IF ( nPairNo == 0 )
  120.       RETURN ( NIL )    // NOTE
  121.    END
  122.  
  123.    RETURN ( aBucket[nPairNo][DI_VAL] )
  124.  
  125.  
  126.  
  127. /***
  128. *
  129. *  DictPut( <aDictionary>, <cKey>, <xValue> ) --> <xValue>
  130. *
  131. *  Add or replace the value for a particular key
  132. *  Returns the value being added
  133. *
  134. */
  135. FUNCTION DictPut( aDict, cKey, xVal )
  136.  
  137.    DictPutPair( aDict, { cKey, xVal } )   // Put an item by putting the pair
  138.  
  139.    RETURN ( xVal )
  140.  
  141.  
  142.  
  143. /***
  144. *
  145. *  DictPutPair( <aDictionary>, <aPair> ) --> <aPair>
  146. *
  147. *  Add or replace key/value pair for a particular key
  148. *  Returns the pair being added
  149. *
  150. */
  151. FUNCTION DictPutPair( aDict, aPair )
  152.  
  153.    LOCAL aBucket        // Contains the key/value pair
  154.    LOCAL cKey           // Key value of the pair to be 'put'
  155.    LOCAL nLocation      // Location in aDict where aPair will reside
  156.  
  157.    cKey := aPair[ DI_KEY ]
  158.  
  159.    aBucket := aDict[ HASH_VAL( cKey, LEN( aDict )) ]
  160.    nLocation := ASCAN( aBucket, { |aPair| aPair[ DI_KEY ] == cKey } )
  161.  
  162.    IF ( nLocation == 0 )
  163.       AAdd( aBucket, aPair )
  164.       nLocation := Len( aBucket )
  165.    ELSE
  166.       aBucket[nLocation] := aPair
  167.    ENDIF
  168.  
  169.    IF ( nLocation > 3 .AND. LEN( aDict ) < MAX_ARRAY_LEN )
  170.         // this bucket is big, grow dict
  171.       DictResize( aDict )
  172.    ENDIF
  173.  
  174.    RETURN ( aPair )
  175.  
  176.  
  177.  
  178. /***
  179. *
  180. *  DictRemove( <aDict>, <cKey> ) --> <aDict>
  181. *
  182. *  Remove the key/value pair for a particular key
  183. *  Returns a reference to the dictionary
  184. *
  185. */
  186. FUNCTION DictRemove( aDict, cKey )
  187.  
  188.    LOCAL aBucket     // Pair corresponding to cKey
  189.    LOCAL nLocation   // Location of the pair in aDict
  190.  
  191.    aBucket := aDict[ HASH_VAL( cKey, LEN( aDict )) ]
  192.    nLocation := ASCAN( aBucket, { |aPair| aPair[ DI_KEY ] == cKey } )
  193.  
  194.    IF ( nLocation <> 0 )
  195.       ADEL( aBucket, nLocation )
  196.       ASIZE( aBucket, LEN( aBucket ) - 1 )
  197.    ENDIF
  198.  
  199.    RETURN ( aDict )
  200.  
  201.  
  202.  
  203. /***
  204. *
  205. *  DictEval( <aDict>, <bCode> ) --> <aDict>
  206. *
  207. *  Evaluate block against each pair in the dictionary
  208. *  The pair is passed to the block.
  209. *
  210. *  Returns reference to <aDict>
  211. *
  212. */
  213. FUNCTION DictEval( aDict, bCode )
  214.  
  215.    AEVAL( aDict, ;
  216.       { |aBucket| AEVAL( aBucket, { |aPair| EVAL( bCode, aPair ) } ) } )
  217.  
  218.    RETURN ( aDict )
  219.  
  220.  
  221.  
  222. /***
  223. *
  224. *  DictResize( <aDict> ) --> aNewDictionary
  225. *
  226. *  Grows dictionary hash table
  227. *
  228. *  NOTES:
  229. *     Rehashes, invalidating any direct indexes into <aDict> held
  230. *     by caller across this call
  231. *
  232. *     Since DictResize is a service routine, it is declared STATIC and is
  233. *     is invisible to other program (.prg) files.
  234. *
  235. */
  236. STATIC FUNCTION DictResize( aDict )
  237.  
  238.    LOCAL aOldDict
  239.    LOCAL nNewDictSize
  240.    LOCAL nCounter
  241.  
  242.    // Make a copy of the old dictionary
  243.    aOldDict := ARRAY( LEN( aDict ))
  244.    ACOPY( aDict, aOldDict )
  245.  
  246.    // Resize and clear the dictionary
  247.    nNewDictSize := MIN( LEN( aDict ) * 4 - 1, MAX_ARRAY_LEN )
  248.    ASIZE( aDict, nNewDictSize )
  249.  
  250.    FOR nCounter := 1 TO nNewDictSize
  251.       aDict[nCounter] := {}
  252.     NEXT
  253.  
  254.    // Rehash pairs into dict
  255.    AEVAL( aOldDict,                                                     ;
  256.           { |aBucket| AEVAL( aBucket,                                   ;
  257.                              { |aPair| DictPutPair( aDict, aPair ) } )  ;
  258.           } )
  259.  
  260.    RETURN ( aDict )
  261.