home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR503.W96 / NUM.PR_ / NUM.PR
Encoding:
Text File  |  1995-06-20  |  7.8 KB  |  355 lines
  1. /***
  2. *
  3. *  Num.prg
  4. *
  5. *  Sample user-defined functions for manipulating numbers
  6. *
  7. *  Copyright (c) 1993-1995, Computer Associates International Inc.
  8. *  All rights reserved.
  9. *
  10. *  NOTE: compile with /a /m /n /w
  11. *
  12. */
  13.  
  14. #define PI  ( 3.1415926535897932384626433 )
  15.  
  16.  
  17. /***
  18. *
  19. *  BaseToBase( <cInString>, <nInBase>, <nOutBase> ) --> cNewBaseValue
  20. *
  21. *  Transform a string of a number from one base to another
  22. *  within the base range of 2 to 36
  23. *
  24. *  Parameters:
  25. *     cInString - The number to convert in character string format
  26. *     nInBase   - The base of <cInString>
  27. *     nOutBase  - The base to covert <cInString> into
  28. *
  29. *  Returns:
  30. *     <cInString> in base <nOutBase> as a character string
  31. *
  32. *  NOTE: Compile with /dNOARGCHECK to suppress argument checking
  33. *
  34. */
  35. FUNCTION BaseToBase( cInString, nInBase, nOutBase )
  36.  
  37.    LOCAL cDigits       := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  38.    LOCAL cNewBaseValue := ""
  39.    LOCAL i
  40.    LOCAL DecPos
  41.    LOCAL IntValue      := 0
  42.    LOCAL FracValue     := 0.000000000000000000
  43.    LOCAL FracProduct
  44.    LOCAL FracCounter
  45.    LOCAL IntProdStr
  46.    LOCAL FracOutStr
  47.    LOCAL IntOutString
  48.    LOCAL IntStr
  49.    LOCAL FracString
  50.    LOCAL FracLimit
  51.    LOCAL Block
  52.    LOCAL LChr
  53.    LOCAL Remainder
  54.    LOCAL Quotient
  55.    LOCAL NegSign
  56.  
  57.    cInString := UPPER( ALLTRIM( cInString ) )
  58.  
  59. #ifndef NOARGCHECK
  60.  
  61.    // Check parameters
  62.    IF EMPTY( cInString ) .OR. VALTYPE( cInString ) <> "C" .OR. LEN( cInString ) > 19
  63.       cNewBaseValue := NIL
  64.    ELSE
  65.       nInBase := IF( EMPTY( nInBase  ), 10, nInBase  )
  66.       nOutBase := IF( EMPTY( nOutBase ), 10, nOutBase )
  67.  
  68.       IF VALTYPE( nInBase ) <> "N" .OR. VALTYPE( nOutBase ) <> "N"
  69.          cNewBaseValue := NIL
  70.       ELSE
  71.  
  72.          // Check out-of-range bases
  73.          IF ( nInBase > 36 .OR. nOutBase > 36 .OR. nInBase < 2 .OR. nOutBase < 2 )
  74.             cNewBaseValue := NIL
  75.          ELSE
  76.             i := 1
  77.  
  78.             DO WHILE i++ < LEN( cInString ) .AND. cNewBaseValue <> NIL
  79.                IF .NOT. SUBSTR( cInString, i, 1 ) $ ( SUBSTR( cDigits, 1, nInBase ) + "." )
  80.                   cNewBaseValue := NIL
  81.                ENDIF
  82.             ENDDO
  83.  
  84.          ENDIF
  85.  
  86.       ENDIF
  87.    ENDIF
  88.  
  89. #endif
  90.  
  91.    IF cNewBaseValue <> NIL
  92.  
  93.       // Check if cInString is negative
  94.       NegSign := IF( SUBSTR( cInString, 1, 1 ) == "-", "-", "" )
  95.       IF .NOT. EMPTY( NegSign )
  96.          cInString := SUBSTR( ALLTRIM( SUBSTR( cInString, 2 ) ), 2 )
  97.       ENDIF
  98.  
  99.       // Locate the decimal
  100.       DecPos := AT( ".", cInString )
  101.       IntStr := IF( DecPos > 1, SUBSTR( cInString, 1, DecPos - 1 ), IF( DecPos == 1, "0", cInString ) )
  102.       FracString := IF( DecPos > 0, SUBSTR( cInString, DecPos + 1 ), "0" )
  103.  
  104.       // Convert integer portion to base 10
  105.       FOR i = LEN( IntStr ) TO 1 STEP -1
  106.          IntValue += ( AT( SUBSTR( IntStr, i, 1 ), cDigits) - 1) * ( nInBase ** ( LEN( IntStr ) - i ) )
  107.       NEXT
  108.  
  109.       // Convert fraction portion to base 10
  110.       FOR i := 1 TO LEN( FracString )
  111.          FracValue += ( AT( SUBSTR( FracString, i, 1 ), cDigits ) - 1 ) * ( nInBase ** ( - i ) )
  112.       NEXT
  113.  
  114.       // Calculate output string for integer portion
  115.       Quotient     := IntValue
  116.       IntOutString := ""
  117.  
  118.       DO WHILE Quotient <> 0
  119.          Remainder    := Quotient % nOutBase
  120.          Quotient     := INT( Quotient / nOutBase )
  121.          IntOutString := SUBSTR( cDigits, Remainder + 1, 1 ) + IntOutString
  122.       ENDDO
  123.  
  124.       IntOutString := IF( EMPTY( IntOutstring ), "0", IntOutString )
  125.  
  126.       // Calculate output string for fraction portion
  127.       FracLimit   := 19 - DecPos
  128.       FracProduct := FracValue
  129.       FracCounter := 1
  130.       FracOutStr  := ""
  131.  
  132.       // If the following WHILE condition is replaced with
  133.       // FracCounter++ < FracLimit .AND. FracProduct < 0.00000000000001
  134.       // then there is no need for execute the block to get rid of
  135.       // trailing zeros.
  136.  
  137.       DO WHILE FracCounter++ < FracLimit .AND. FracProduct <> 0
  138.          IntProdStr  := FracProduct * nOutBase
  139.          FracOutStr  := FracOutStr + SUBSTR( cDigits, INT( IntProdStr ) + 1, 1 )
  140.          FracProduct := IntProdStr - INT( IntProdStr )
  141.       ENDDO
  142.  
  143.       // Get rid of trailing zeros from the fraction portion
  144.       Block:={ || LChr := RIGHT(FracOutStr, 1), ;
  145.          IF(LChr == "0", FracOutStr := SUBSTR(FracOutStr, 1, LEN(FracOutStr) - 1), 0), ;
  146.          IF(LChr == "0", EVAL(Block), FracOutStr) }
  147.       FracOutStr := EVAL( Block )
  148.  
  149.       /* The following block takes more memory but is shorter
  150.          Block := { |Str| IF(RIGHT(Str, 1) == "0", ;
  151.             EVAL(Block, SUBSTR(FracOutStr, 1, LEN(FracOutStr) - 1)), Str)}
  152.       */
  153.  
  154.    ENDIF
  155.  
  156.    // Output
  157.    IF cNewBaseValue <> NIL
  158.       cNewBaseValue := IF( DecPos > 0, NegSign + IntOutString + "." + FracOutStr, IntOutString )
  159.    ENDIF
  160.  
  161.    RETURN ( cNewBaseValue )
  162.  
  163.  
  164.  
  165. /***
  166. *
  167. *  Ceiling( <nNumber> ) --> nInteger
  168. *
  169. *  Return the smallest integer that is greater than or equal to <nNumber>
  170. *
  171. */
  172. FUNCTION Ceiling( nNumber )
  173.  
  174.    LOCAL nInteger
  175.  
  176.    IF ( INT( nNumber ) == nNumber ) .OR. ( nNumber < 0 )
  177.  
  178.       // Integers and negative non-integers
  179.       nInteger := INT( nNumber )
  180.  
  181.    ELSEIF ( nNumber > 0 )
  182.  
  183.       // Positive non-integers
  184.       nInteger := INT( nNumber + 1 )
  185.  
  186.    ENDIF
  187.  
  188.    RETURN ( nInteger )
  189.  
  190.  
  191.  
  192. /***
  193. *
  194. *  DtoR( <nDegrees> ) --> nRadians
  195. *
  196. *  Convert an angle size specified in radians to degrees
  197. *
  198. */
  199. FUNCTION DtoR( nDegrees )
  200.    RETURN (( nDegrees/180 ) * PI )
  201.  
  202.  
  203.  
  204. /***
  205. *
  206. *  Floor( <nNumber> ) --> nInteger
  207. *
  208. *  Return the largest integer that is less than or equal to <nNumber>
  209. *
  210. */
  211. FUNCTION Floor( nNumber )
  212.    
  213.    LOCAL nInteger
  214.  
  215.    IF ( INT( nNumber ) == nNumber ) .OR. ( nNumber > 0 )
  216.       
  217.       // Integers and positive non-integers
  218.       nInteger := INT( nNumber )
  219.  
  220.    ELSEIF ( nNumber < 0 )
  221.       
  222.       // Negative non-integers
  223.       nInteger := INT( nNumber - 1 )
  224.  
  225.    ENDIF
  226.  
  227.    RETURN ( nInteger )
  228.  
  229.  
  230.  
  231. /***
  232. *
  233. *  NumAsCurrency( <nNumber>, <cSymbol>, <nSide> ) --> cCurrency
  234. *
  235. *  Convert number to currency format, floating dollar symbol
  236. *
  237. */
  238. FUNCTION NumAsCurrency( nNumber, cSymbol, nSide )
  239.    
  240.    LOCAL cCurrency
  241.  
  242.    // If nSide is negative, currency symbol goes on the left
  243.    IF ( nSide < 0 )
  244.       
  245.       cCurrency := cSymbol + LTRIM( STR( nNumber ))
  246.  
  247.    ELSE  // Otherwise, currency symbol goes on the right
  248.       
  249.       cCurrency := RTRIM( STR( nNumber )) + cSymbol
  250.  
  251.    ENDIF
  252.  
  253.    RETURN ( cCurrency )
  254.  
  255.  
  256.  
  257. /***
  258. *
  259. *  NumAsLog10( <nNumber> ) --> nLog10 
  260. *
  261. *  Convert a positive number to log base 10
  262. *
  263. */
  264. FUNCTION NumAsLog10( nNumber )        
  265.    
  266.    IF ( nNumber > 0 )
  267.       
  268.       RETURN LOG( nNumber )/LOG( 10 )     //NOTE
  269.  
  270.    ENDIF
  271.  
  272.    RETURN ( NIL )
  273.  
  274.  
  275.  
  276. /***
  277. *
  278. *  NumGetDecimals( <nNumber> ) --> nDecimals
  279. *
  280. *  Determine the number of decimal digits
  281. *
  282. */
  283. FUNCTION NumGetDecimals( nNumber )
  284.    
  285.    LOCAL cNum
  286.    LOCAL nPos
  287.  
  288.    cNum := STR( nNumber )
  289.    nPos := AT( ".", cNum )
  290.  
  291.    IF nPos > 0
  292.       RETURN( LEN( ALLTRIM( SUBSTR( cNum, nPos + 1 ))))
  293.    ENDIF
  294.  
  295.    RETURN ( 0 )
  296.  
  297.  
  298.  
  299. /***
  300. *
  301. *  NumGetLen( <nNumber> ) --> nDigits
  302. *
  303. *  Determine the number of whole number digits
  304. *
  305. */
  306. FUNCTION NumGetLen( nNumber )
  307.    
  308.    LOCAL cNum
  309.  
  310.    cNum := STR( INT( ABS( nNumber )))
  311.  
  312.    RETURN ( LEN( ALLTRIM( cNum )))
  313.  
  314.  
  315.  
  316. /***
  317. *
  318. *  RtoD( <nRadians> ) --> nDegrees
  319. *
  320. *  Convert an angle size specified in radians to degrees
  321. *
  322. */
  323. FUNCTION RtoD( nRadians )
  324.    RETURN ( 180 * ( nRadians/PI ))
  325.  
  326.  
  327.  
  328. /***
  329. *
  330. *  Sign( <nNumber> ) --> nSign
  331. *
  332. *  Return the sign of a number as follows:
  333. *     0 - <nNumber> is zero
  334. *     1 - <nNumber> is positive
  335. *    -1 - <nNumber> is negative
  336. *
  337. */
  338. FUNCTION Sign( nNumber )
  339.    
  340.    LOCAL nSign
  341.  
  342.    DO CASE
  343.    CASE nNumber == 0
  344.       nSign := 0
  345.  
  346.    CASE nNumber > 0
  347.       nSign := 1
  348.  
  349.    CASE nNumber < 0
  350.       nSign := -1
  351.  
  352.    ENDCASE
  353.  
  354.    RETURN ( nSign )
  355.