home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 6.ddi / SAMPLE.LIF / NUM.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  7.1 KB  |  281 lines
  1. /***
  2. *
  3. *  Num.prg
  4. *  Sample user-defined functions for manipulating numbers
  5. *
  6. *  Copyright, Nantucket Corporation, 1990
  7. *
  8. *  NOTE: compile with /n/w/a/m
  9. */
  10.  
  11.  
  12. /***
  13. *  BaseToBase( <cInString>, <nInBase>, <nOutBase> ) --> cNewBaseValue
  14. *  Transform a string of a number from one base to another 
  15. *  within the base range of 2 to 36
  16. *
  17. *  Jake Jacob and Flemming Ho
  18. *
  19. *  Note: Compile with /dNOARGCHECK to suppress argument checking
  20. *
  21. */
  22. FUNCTION BaseToBase( cInString, nInBase, nOutBase )
  23.    LOCAL DIGITS := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", cNewBaseValue := ""
  24.    LOCAL i, DecPos, IntValue := 0, FracValue := 0.000000000000000000
  25.    LOCAL FracProduct, FracCounter, IntProdStr, FracOutStr, IntOutString
  26.    LOCAL IntStr, FracString, FracLimit, Block, LChr, Remainder, Quotient
  27.    LOCAL NegSign
  28.  
  29.    cInString := UPPER( ALLTRIM( cInString ) )
  30.  
  31.    #ifndef NOARGCHECK
  32.    // Check parameters
  33.    IF EMPTY( cInString ) .OR. VALTYPE( cInString ) <> "C" .OR. LEN( cInString ) > 19
  34.       cNewBaseValue := NIL
  35.    ELSE
  36.       nInBase := IF( EMPTY( nInBase  ), 10, nInBase  )
  37.       nOutBase := IF( EMPTY( nOutBase ), 10, nOutBase )
  38.       IF VALTYPE( nInBase ) <> "N" .OR. VALTYPE( nOutBase ) <> "N"
  39.          cNewBaseValue := NIL
  40.       ELSE
  41.          // Check out-of-range bases
  42.          IF ( nInBase > 36 .OR. nOutBase > 36 .OR. nInBase < 2 .OR. nOutBase < 2 )
  43.             cNewBaseValue := NIL
  44.          ELSE
  45.             i := 1
  46.             DO WHILE i++ < LEN( cInString ) .AND. cNewBaseValue <> NIL
  47.                IF .NOT. SUBSTR( cInString, i, 1 ) $ ( SUBSTR( DIGITS, 1, nInBase ) + "." )
  48.                   cNewBaseValue := NIL
  49.                ENDIF
  50.             ENDDO
  51.          ENDIF
  52.       ENDIF
  53.    ENDIF
  54.    #endif
  55.  
  56.    IF cNewBaseValue <> NIL
  57.  
  58.       // Check if cInString is negative
  59.       NegSign := IF( SUBSTR( cInString, 1, 1 ) == "-", "-", "" )
  60.       IF .NOT. EMPTY( NegSign )
  61.          cInString := SUBSTR( ALLTRIM( SUBSTR( cInString, 2 ) ), 2 )
  62.       ENDIF
  63.  
  64.       // Locate the decimal
  65.       DecPos := AT( ".", cInString )
  66.       IntStr := IF( DecPos > 1, SUBSTR( cInString, 1, DecPos - 1 ), IF( DecPos == 1, "0", cInString ) )
  67.       FracString := IF( DecPos > 0, SUBSTR( cInString, DecPos + 1 ), "0" )
  68.  
  69.       // Convert integer portion to base 10
  70.       FOR i = LEN( IntStr ) TO 1 STEP -1
  71.          IntValue += ( AT( SUBSTR( IntStr, i, 1 ), DIGITS) - 1) * ( nInBase ** ( LEN( IntStr ) - i ) )
  72.       NEXT
  73.  
  74.       // Convert fraction portion to base 10
  75.       FOR i := 1 TO LEN( FracString )
  76.          FracValue += ( AT( SUBSTR( FracString, i, 1 ), DIGITS ) - 1 ) * ( nInBase ** ( - i ) )
  77.       NEXT
  78.  
  79.       // Calculate output string for integer portion
  80.       Quotient := IntValue
  81.       IntOutString := ""
  82.  
  83.       DO WHILE Quotient <> 0
  84.          Remainder := Quotient % nOutBase
  85.          Quotient  := INT( Quotient / nOutBase )
  86.          IntOutString := SUBSTR( Digits, Remainder + 1, 1 ) + IntOutString
  87.       ENDDO
  88.  
  89.       IntOutString := IF( EMPTY( IntOutstring ), "0", IntOutString )
  90.  
  91.       // Calculate output string for fraction portion
  92.       FracLimit := 19 - DecPos
  93.       FracProduct := FracValue
  94.       FracCounter := 1
  95.       FracOutStr  := ""
  96.  
  97.       // If the following WHILE condition is replaced with
  98.       // FracCounter++ < FracLimit .AND. FracProduct < 0.00000000000001
  99.       // then there is no need for execute the block to get rid of
  100.       // trailing zeros.
  101.  
  102.       DO WHILE FracCounter++ < FracLimit .AND. FracProduct <> 0
  103.          IntProdStr  := FracProduct * nOutBase
  104.          FracOutStr  := FracOutStr + SUBSTR( Digits, INT( IntProdStr ) + 1, 1 )
  105.          FracProduct := IntProdStr - INT( IntProdStr )
  106.       ENDDO
  107.  
  108.       // Get rid of trailing zeros from the fraction portion
  109.       Block:={ || LChr := RIGHT(FracOutStr, 1), ;
  110.          IF(LChr == "0", FracOutStr := SUBSTR(FracOutStr, 1, LEN(FracOutStr) - 1), 0), ;
  111.          IF(LChr == "0", EVAL(Block), FracOutStr) }
  112.       FracOutStr := EVAL( Block )
  113.  
  114.       /* The following block takes more memory but is shorter
  115.          Block := { |Str| IF(RIGHT(Str, 1) == "0", ;
  116.             EVAL(Block, SUBSTR(FracOutStr, 1, LEN(FracOutStr) - 1)), Str)}
  117.       */
  118.    ENDIF
  119.  
  120.    // Output
  121.    IF cNewBaseValue <> NIL
  122.       cNewBaseValue := IF( DecPos > 0, NegSign + IntOutString + "." + FracOutStr, IntOutString )
  123.    ENDIF
  124.  
  125.    RETURN cNewBaseValue
  126.  
  127.  
  128.  
  129. /***
  130. *  Ceiling( <nNumber> ) --> nInteger
  131. *  Return the smallest integer that is greater than or equal to <nNumber>
  132. *
  133. */
  134. FUNCTION Ceiling( nNumber )
  135.    LOCAL nInteger
  136.  
  137.    IF (INT(nNumber) = nNumber) .OR. (nNumber < 0)
  138.       // Integers and negative non-integers
  139.       nInteger := INT(nNumber)
  140.  
  141.    ELSEIF (nNumber > 0)
  142.       // Positive non-integers
  143.       nInteger := INT(nNumber + 1)
  144.  
  145.    ENDIF
  146.  
  147.    RETURN nInteger
  148.  
  149.  
  150.  
  151. /***
  152. *  Dtor( <nDegrees> ) --> nRadians
  153. *  Convert an angle size specified in radians to degrees
  154. *
  155. */
  156. FUNCTION Dtor( nDegrees )
  157.    RETURN ((nDegrees/180) * PI())
  158.  
  159.  
  160.  
  161. /***
  162. *  Floor( <nNumber> ) --> nInteger
  163. *  Return the largest integer that is less than or equal to <nNumber>
  164. *
  165. */
  166. FUNCTION Floor( nNumber )
  167.    LOCAL nInteger
  168.  
  169.    IF (INT(nNumber) = nNumber) .OR. (nNumber > 0)
  170.       // Integers and positive non-integers
  171.       nInteger := INT(nNumber)
  172.  
  173.    ELSEIF (nNumber < 0)
  174.       // Negative non-integers
  175.       nInteger := INT(nNumber - 1)
  176.  
  177.    ENDIF
  178.  
  179.    RETURN nInteger
  180.  
  181.  
  182.  
  183. /***
  184. *  NumAsCurrency( <nNumber>, <cSymbol>, <nSide> ) --> cCurrency
  185. *  Convert number to currency format, floating dollar symbol
  186. *
  187. */
  188. FUNCTION NumAsCurrency( nNumber, cSymbol, nSide )
  189.    LOCAL cCurrency
  190.    // If nSide is negative, currency symbol goes on the left
  191.    IF nSide < 0
  192.       cCurrency := cSymbol + LTRIM(STR(nNumber))
  193.    // Otherwise, currency symbol goes on the right
  194.    ELSE
  195.       cCurrency := RTRIM(STR(nNumber)) + cSymbol
  196.    ENDIF
  197.    RETURN cCurrency
  198.  
  199.  
  200.  
  201. /***
  202. *  NumAsLog10( <nNumber> ) --> nLog10 
  203. *  Convert a positive number to log base 10
  204. *
  205. */
  206. FUNCTION NumAsLog10( nNumber )        
  207.    IF nNumber > 0
  208.       RETURN LOG(nNumber)/LOG(10)
  209.    ENDIF
  210.  
  211.    RETURN NIL
  212.  
  213.  
  214.  
  215. /***
  216. *  NumGetDecimals( <nNumber> ) --> nDecimals
  217. *  Determine the number of decimal digits
  218. *
  219. */
  220. FUNCTION NumGetDecimals( nNumber )
  221.    LOCAL cNum, nPos
  222.    cNum := STR(nNumber)
  223.    nPos := AT(".", cNum)
  224.    IF nPos > 0
  225.       RETURN(LEN(ALLTRIM(SUBSTR(cNum, nPos + 1))))
  226.    ENDIF
  227.  
  228.    RETURN 0
  229.  
  230.  
  231.  
  232. /***
  233. *  NumGetLen( <nNumber> ) --> nDigits
  234. *  Determine the number of whole number digits
  235. *
  236. */
  237. FUNCTION NumGetLen( nNumber )
  238.    LOCAL cNum
  239.    cNum := STR(INT(ABS(nNumber)))
  240.    RETURN(LEN(ALLTRIM(cNum)))
  241.  
  242.  
  243.  
  244. /***
  245. *  PI() --> nPI
  246. *  Approximates the constant pi
  247. *
  248. */
  249. FUNCTION PI()
  250.    RETURN (3.1415926535897932384626433)
  251.  
  252.  
  253.  
  254. /***
  255. *  Rtod( <nRadians> ) --> nDegrees
  256. *  Convert an angle size specified in radians to degrees
  257. *
  258. */
  259. FUNCTION Rtod( nRadians )
  260.    RETURN (180 * (nRadians/PI()))
  261.  
  262.  
  263.  
  264. /***
  265. *  Sign( <nNumber> ) --> nSign
  266. *  Return the sign of a number
  267. *
  268. */
  269. FUNCTION Sign( nNumber)
  270.    LOCAL nSign
  271.    DO CASE
  272.    CASE nNumber = 0
  273.       nSign := 0
  274.    CASE nNumber > 0
  275.       nSign := 1
  276.    CASE nNumber < 0
  277.       nSign := -1
  278.    ENDCASE
  279.    RETURN nSign
  280.  
  281.