Nachkommastellen abschneiden OHNE Runden ??

[alzaimar]

Zitat von bodenheim:

Zitat von DeddyH:

NeueZahl := trunc(Zahl * 100) / 100;

das klappt. Danke !!

...leider nicht, wenn man bereits mit vermeidlich auf zwei Stellen genauen Zahlen rumhantiert.
Beweis:

Delphi-Quellcode:

program FloatingPointTuecken;
{$APPTYPE CONSOLE}

uses
  SysUtils;

Var
  i  : Integer;
  Beispiel,
  Abgerundet : Double;

  Function Abrunden (Zahl : Double) : Double;
  Begin
      Result := Trunc (Zahl * 100) / 100;
  End;

begin
  for i:=1 to maxint do begin
    Beispiel := i/100;                            // Klar, eine Zahlen auf 2 Stellen
    Abgerundet := Abrunden(Beispiel);             // Sicherheitshalber abrunden
    if Abs (Beispiel - Abgerundet)>0.005 Then     // Falls das nicht klappt, ...
      writeln(i,Beispiel,Abgerundet);             // wundern!
  end;
end.

Abhilfe: Berücksichtigen der Rundungsfehler, indem wir 'fast aufrunden':

Delphi-Quellcode:

function KorrektesAbrunden(Zahl: Double): Double;
Const
  KorrekturDerSchutzStellen = 0.5 - 1E-16;

begin
  If Zahl < 0 then
    Result := Trunc(Zahl * 100 - KorrekturDerSchutzStellen) / 100
  Else
    Result := Trunc(Zahl * 100 + KorrekturDerSchutzStellen) / 100;
end;

Hier der komplette Testcode: Er testet alle Zahlen -maxint/100 .. +maxint/100;

Delphi-Quellcode:

program FloatingPointTuecken;
{$APPTYPE CONSOLE}
uses
  SysUtils;

type
  TAbrundenFunktion = function(Zahl: Double): Double;

function Abrunden(Zahl: Double): Double;
begin
  Result := Trunc(Zahl * 100) / 100;
end;

function KorrektesAbrunden(Zahl: Double): Double;
Const
  KorrekturDerSchutzStellen = 0.5 - 1E-16;

begin
  If Zahl < 0 then
    Result := Trunc(Zahl * 100 - KorrekturDerSchutzStellen) / 100
  Else
    Result := Trunc(Zahl * 100 + KorrekturDerSchutzStellen) / 100;
end;

function ZahlenUngleich(Zahl1, Zahl2: Double): Boolean;
begin
  Result := Abs(Zahl1 - Zahl2) > 0.005;
end;

procedure ZeigeFehler(Funktionsname : String; Zahl, Gerundet: Double);
begin
  Writeln('Die Funktion "',Funktionsname,'" funktioniert nicht korrekt.');
  Writeln('Beispiel:');
  Writeln('  Zahl       : ', Zahl: 8: 2);
  Writeln('  Abgerundet : ', Gerundet: 8: 2);
  Writeln;
end;

procedure TesteKorrektesRundenMit(FunktionsName : String;
  EineAbrundenFunktion: TAbrundenFunktion);
var
  i: Integer;
  Beispiel,
    Abgerundet : Double;

begin
  for i := -maxint to maxint do begin
    Beispiel := i / 100;
    Abgerundet := EineAbrundenFunktion(Beispiel);
    if ZahlenUngleich(Beispiel, Abgerundet) then begin
      ZeigeFehler(Funktionsname, Beispiel, Abgerundet);
      Exit;
    end;
  end;
  Writeln('Die Funktion "',Funktionsname,'" funktioniert besser');
end;

begin
  TesteKorrektesRundenMit('Gängige Version', Abrunden);
  TesteKorrektesRundenMit('Korrigierte Version', KorrektesAbrunden);
  ReadLn;
end.