我相信 Delphi RTL 的 SimpleRoundTo 函数基本上可以做到这一点,至少如果 FPU 舍入模式是“正确的”。请仔细阅读其文档和实现,然后确定它是否足以满足您的目的。
但请注意,设置像这样的单个舍入操作的舍入模式是使用全局更改来解决局部问题。这可能会导致问题(多线程、库等)。
奖金喋喋不休:如果问题是关于“常规”舍入(到整数),我想我已经尝试过类似的方法
function RoundMidpAway(const X: Real): Integer;
begin
Result := Trunc(X);
if Abs(Frac(X)) >= 0.5 then
Inc(Result, Sign(X));
end;
改为。
当然,即使对于 n 小数的一般情况,也可以编写类似的函数。 (但要注意正确处理边缘情况、溢出、浮点问题等。)
更新:我相信以下方法可以解决问题(而且速度很快):
function RoundMidpAway(const X: Real): Integer; overload;
begin
Result := Trunc(X);
if Abs(Frac(X)) >= 0.5 then
Inc(Result, Sign(X));
end;
function RoundMidpAway(const X: Real; ADigit: integer): Real; overload;
const
PowersOfTen: array[-10..10] of Real =
(
0.0000000001,
0.000000001,
0.00000001,
0.0000001,
0.000001,
0.00001,
0.0001,
0.001,
0.01,
0.1,
1,
10,
100,
1000,
10000,
100000,
1000000,
10000000,
100000000,
1000000000,
10000000000
);
var
MagnifiedValue: Real;
begin
if not InRange(ADigit, Low(PowersOfTen), High(PowersOfTen)) then
raise EInvalidArgument.Create('Invalid digit index.');
MagnifiedValue := X * PowersOfTen[-ADigit];
Result := RoundMidpAway(MagnifiedValue) * PowersOfTen[ADigit];
end;
当然,如果您要在生产代码中使用此功能,您还需要添加至少 50 个单元测试用例来测试其正确性(每天运行)。
更新:我相信以下版本更稳定:
function RoundMidpAway(const X: Real; ADigit: integer): Real; overload;
const
FuzzFactor = 1000;
DoubleResolution = 1E-15 * FuzzFactor;
PowersOfTen: array[-10..10] of Real =
(
0.0000000001,
0.000000001,
0.00000001,
0.0000001,
0.000001,
0.00001,
0.0001,
0.001,
0.01,
0.1,
1,
10,
100,
1000,
10000,
100000,
1000000,
10000000,
100000000,
1000000000,
10000000000
);
var
MagnifiedValue: Real;
TruncatedValue: Real;
begin
if not InRange(ADigit, Low(PowersOfTen), High(PowersOfTen)) then
raise EInvalidArgument.Create('Invalid digit index.');
MagnifiedValue := X * PowersOfTen[-ADigit];
TruncatedValue := Int(MagnifiedValue);
if CompareValue(Abs(Frac(MagnifiedValue)), 0.5, DoubleResolution * PowersOfTen[-ADigit]) >= EqualsValue then
TruncatedValue := TruncatedValue + Sign(MagnifiedValue);
Result := TruncatedValue * PowersOfTen[ADigit];
end;
但我还没有完全测试它。 (目前它通过了900+ unit test cases,但我认为测试套件还不够充分。)