Rev 8859 | Details | Compare with Previous | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 9893 | akron1 | 1 | (* ****************************************** |
| 2 | Дополнительные функции к модулю Math. |
||
| 3 | Функции округления. |
||
| 4 | Вадим Исаев, 2020 |
||
| 5 | ------------------------------------- |
||
| 6 | Additional functions to the module Math. |
||
| 7 | Rounding functions. |
||
| 8 | Vadim Isaev, 2020 |
||
| 9 | ********************************************* *) |
||
| 10 | |||
| 11 | MODULE MathRound; |
||
| 12 | |||
| 13 | IMPORT Math; |
||
| 14 | |||
| 15 | |||
| 16 | (* Возвращается целая часть числа x. |
||
| 17 | Returns the integer part of a argument x.*) |
||
| 18 | PROCEDURE trunc* (x: REAL): REAL; |
||
| 19 | VAR |
||
| 20 | a: REAL; |
||
| 21 | |||
| 22 | BEGIN |
||
| 23 | a := FLT(FLOOR(x)); |
||
| 24 | IF (x < 0.0) & (x # a) THEN |
||
| 25 | a := a + 1.0 |
||
| 26 | END |
||
| 27 | |||
| 28 | RETURN a |
||
| 29 | END trunc; |
||
| 30 | |||
| 31 | |||
| 32 | (* Возвращается дробная часть числа x. |
||
| 33 | Returns the fractional part of the argument x *) |
||
| 34 | PROCEDURE frac* (x: REAL): REAL; |
||
| 35 | RETURN x - trunc(x) |
||
| 36 | END frac; |
||
| 37 | |||
| 38 | |||
| 39 | (* Округление к ближайшему целому. |
||
| 40 | Rounding to the nearest integer. *) |
||
| 41 | PROCEDURE round* (x: REAL): REAL; |
||
| 42 | VAR |
||
| 43 | a: REAL; |
||
| 44 | |||
| 45 | BEGIN |
||
| 46 | a := trunc(x); |
||
| 47 | IF ABS(frac(x)) >= 0.5 THEN |
||
| 48 | a := a + FLT(Math.sgn(x)) |
||
| 49 | END |
||
| 50 | |||
| 51 | RETURN a |
||
| 52 | END round; |
||
| 53 | |||
| 54 | |||
| 55 | (* Округление к бОльшему целому. |
||
| 56 | Rounding to a largest integer *) |
||
| 57 | PROCEDURE ceil* (x: REAL): REAL; |
||
| 58 | VAR |
||
| 59 | a: REAL; |
||
| 60 | |||
| 61 | BEGIN |
||
| 62 | a := FLT(FLOOR(x)); |
||
| 63 | IF x # a THEN |
||
| 64 | a := a + 1.0 |
||
| 65 | END |
||
| 66 | |||
| 67 | RETURN a |
||
| 68 | END ceil; |
||
| 69 | |||
| 70 | |||
| 71 | (* Округление к меньшему целому. |
||
| 72 | Rounding to a smallest integer *) |
||
| 73 | PROCEDURE floor* (x: REAL): REAL; |
||
| 74 | RETURN FLT(FLOOR(x)) |
||
| 75 | END floor; |
||
| 76 | |||
| 77 | |||
| 78 | (* Округление до определённого количества знаков: |
||
| 79 | - если Digits отрицательное, то округление |
||
| 80 | в знаках после десятичной запятой; |
||
| 81 | - если Digits положительное, то округление |
||
| 82 | в знаках до запятой *) |
||
| 83 | PROCEDURE SimpleRoundTo* (AValue: REAL; Digits: INTEGER): REAL; |
||
| 84 | VAR |
||
| 85 | RV, a : REAL; |
||
| 86 | |||
| 87 | BEGIN |
||
| 88 | RV := Math.ipower(10.0, -Digits); |
||
| 89 | IF AValue < 0.0 THEN |
||
| 90 | a := trunc((AValue * RV) - 0.5) |
||
| 91 | ELSE |
||
| 92 | a := trunc((AValue * RV) + 0.5) |
||
| 93 | END |
||
| 94 | |||
| 95 | RETURN a / RV |
||
| 96 | END SimpleRoundTo; |
||
| 97 | |||
| 98 | |||
| 8097 | maxcodehac | 99 | END MathRound. |