AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Algorithmen Delphi Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

Ein Thema von Daniel B · begonnen am 12. Jul 2003 · letzter Beitrag vom 13. Jul 2003
Antwort Antwort
Daniel B
(Gast)

n/a Beiträge
 
#1

Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

  Alt 12. Jul 2003, 18:01
Hallo,

hiermit kann man normale Integer in römische Zahlen umwandeln und sich als String zurück geben lassen.
Delphi-Quellcode:
function DecToRoman(Decimal: Longint): String;
const
  Romans: Array[1..16] of String = ('I', 'IV', 'V', 'IX', 'X', 'XL',
                                    'L', 'XC', 'C', 'CD', 'D', 'CM',
                                    'M', '(M)', '[M]', '{M}');
  Arabics: Array[1..16] of Integer = (1, 4, 5, 9, 10, 40, 50, 90, 100,
                                      400, 500, 900, 1000, 10000, 100000, 1000000);
var
   iFor: Integer;
begin
  Result := '';
  for iFor := 16 downto 1 do
  begin
    while(Decimal >= Arabics[iFor]) do
    begin
      Decimal := Decimal - Arabics[iFor];
      Result := Result + Romans[iFor];
    end;
  end;
end;
So wäre der Aufruf:
Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(DecToRoman(1234567));
end;
Grüsse, Daniel
  Mit Zitat antworten Zitat
Daniel B
(Gast)

n/a Beiträge
 
#2

Re: Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

  Alt 12. Jul 2003, 21:49
Hallo,

hier wäre mal das Gegenstück dazu, weitere und schnellere Lösungen siehe weiter unten.
Delphi-Quellcode:
function RomanToDec(Roman: String): LongInt;
const
  Romans: Array[1..18] of String = ('I', 'V', 'X', 'L', 'C', 'D', 'M', 'IV', 'IX', 'XL',
                                    'XC', 'IC', 'CD', 'CM', 'IM', '(M)', '[M]', '{M}');
  Arabics: Array[1..18] of Integer = (1, 5, 10, 50, 100, 500, 1000, 4, 9, 40,
                                      90, 99, 400, 900, 999, 10000, 100000, 1000000);

  procedure ConvertDigit(var sText: String; var iRes: Integer; const sRom: String;
    const iRab: Integer);
  var iTemp: Integer;
  begin
    repeat
      iTemp := Pos(sRom, sText);
      if iTemp >= 1 then
      begin
        Inc(iRes, iRab);
        Delete(sText, iTemp, Length(sRom));
      end;
    until iTemp = 0;
  end;

var
  iFor: Integer;
begin
  Result := 0;
  for iFor := 18 downto 1 do
  begin
    ConvertDigit(Roman, Result, Romans[iFor], Arabics[iFor]);
  end;
end;
Grüsse, Daniel
  Mit Zitat antworten Zitat
Daniel B
(Gast)

n/a Beiträge
 
#3

Re: Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

  Alt 12. Jul 2003, 21:50
Hallo,

hier ist noch ne weitere Lösung.
Delphi-Quellcode:
function RomanToDec2(Roman: String): LongInt;
const
  Romans: Array[1..18] of String = ('I', 'V', 'X', 'L', 'C', 'D', 'M', 'IV', 'IX', 'XL',
                                    'XC', 'IC', 'CD', 'CM', 'IM', '(M)', '[M]', '{M}');
  Arabics: Array[1..18] of Integer = (1, 5, 10, 50, 100, 500, 1000, 4, 9, 40,
                                      90, 99, 400, 900, 999, 10000, 100000, 1000000);
var
  iFor, iPos: Integer;
begin
  Result := 0;
  repeat
    for iFor := High(Romans) downto Low(Romans) do
    begin
      repeat
        iPos := Pos(Romans[iFor], Roman);
        if iPos > 0 then
        begin
          Inc(Result, Arabics[iFor]);
          Delete(Roman, iPos, Length(Romans[iFor]));
        end;
      until iPos = 0;
    end;
  until Length(Roman) = 0;
end;
Grüsse, Daniel
  Mit Zitat antworten Zitat
Benutzerbild von sakura
sakura

Registriert seit: 10. Jun 2002
Ort: München
11.412 Beiträge
 
Delphi 11 Alexandria
 
#4

Re: Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

  Alt 12. Jul 2003, 22:04
Und hier meine Lösung für die Rück-Verwandlung. Diese sind mit Daniel B abgesprochen und ich hatte mal gerade nichts zu tun. Der Hauptgrund für die Lösung ist, Euch gleichzeitig mal Möglichkeiten für Optimierungen offenzulegen. Erst einmal zum Lösungsansatz.

Idee ist folgende. Jedes Roman-Numeral wird separat entschlüsselt und zwischengespeichert. Anschließend wird es mit dem nächsten verglichen. Ist das nächste größer Numeral vom Wert größer, so muss das letzte von Gesamtergebnis subtrahiert werden, ansonsten wird es addiert. usw.

Hier erst einmal die nicht-optimierte Variante, welche aber leichter verständlich ist.
Delphi-Quellcode:
function RomanToDec3(Roman: String): LongInt;
  function Value(Numeral: String): Integer;
  const
    Romans: Array[1..10] of String = ('I', 'V', 'X', 'L', 'C', 'D', 'M', '(M)',
        '[M]', '{M}');
    Arabics: Array[1..10] of Integer = (1, 5, 10, 50, 100, 500, 1000, 10000,
        100000, 1000000);
  var
    I: Integer;
  begin
    Result := 0;
    // alle roman numerals durchlaufen und match in "arabisch" zurückgeben
    for I := Low(Romans) to High(Romans) do
      if Romans[I] = Numeral then
      begin
        Result := Arabics[I];
        Break;
      end;
  end;
var
  Next: String;
  Current, This, IPos, Len: Integer;
begin
  // endergebnis
  Result := 0;
  // current hält den letzten ermittelten wert
  Current := 0;
  // jedes roman testen und verarbeiten
  Len := Length(Roman);
  IPos := 1;
  while IPos <= Len do
  begin
    // nächstes roman holen
    if Roman[IPos] in ['(', '[', '{'] then
    begin
      // die besonderen sind 3 zeichen lang
      Next := Copy(Roman, IPos, 3);
      Inc(IPos, 3);
    end else begin
      // der rest nur eines
      Next := Roman[IPos];
      Inc(IPos);
    end;
    // wert in "arabisch" umwandeln
    This := Value(Next);
    if This = 0 then
      // fehleraft, skip
      Continue;
    if Current > 0 then
    begin
      // der letzte wert muss berücksichtigt werden
      if This > Current then
      begin
        // der aktuelle wert ist größer als der letzte
        // also muss der letzte abgezogen werden
        // und der aktuelle hinzuaddiert werden
        Result := Result - Current + This;
        // der atkuelle wert muss nicht in der nächsten runde berücksichtigt
        // werden
        Current := 0;
      end else begin
        // der letzte wert wird addiert
        Result := Result + Current;
        // der aktuelle wert wird notiert
        Current := This;
      end;
    end else begin
      // der aktuelle wert wird notiert
      Current := This;
    end;
  end;
  // der letzte nicht berücksichtigte wert wird addiert
  Result := Result + Current;
end;
Die folgende Variante ist optimiert und bringt zwischen ca. 80 und 97 Prozent Geschwindigkeitsvorteil und das ohne Assembler. Es ist lediglich die Rücksichtnahme auf drei Gegebenheiten. Zu beachten ist, das der zugrunde liegende Algorithmus 100% identisch ist.

Der größte der Vorteile wird dadurch erzielt, das die Funktion Value durch ein case-Statement ersetzt wird. Einerseits umgehe ich die etwas langsamere Schleife, andererseits den langwierigen Funktionsaufruf. Dieser verbraucht am meisten Zeit.

Der zweite Vorteil liegt in der Verarbeitung des Strings. Anstatt die berechneten Wert aus dem String zu löschen, arbeite ich mit der Variable IPos, welche den aktuellen Index im String zurückgibt. Mit jedem verarbeiteten Roman-Numeral wird diese entsprechend erhöht.

Der dritte Vorteil ergibt sich aus der Nutzung des zweiten Vorteils. Es wird nicht mehr das überprüfenden Numeral kopiert, sondern lediglich der aktulle Character and das case-Statement (Vorteil 1) geliefert.

Hier nun die optimierte Lösung:
Delphi-Quellcode:
function RomanToDec3Optimized(const Roman: String): LongInt;
var
  Current, This, IPos, Len: Integer;
begin
  // endergebnis
  Result := 0;
  // current hält den letzten ermittelten wert
  Current := 0;
  This := 0;
  // jedes roman testen und verarbeiten
  // dabei merkt sich der algo, die aktuelle position im string
  // das ist schneller, als den string an und für sich zu manipulieren
  Len := Length(Roman);
  IPos := 1;
  while IPos <= Len do
  begin
    // nächstes roman holen
    case Roman[IPos] of
      // die sonder-numerals sind 3 char lang, deshalb INC(IPos, 3)
      '{': begin
        This := 1000000;
        Inc(IPos, 3);
      end;
      '[': begin
        This := 100000;
        Inc(IPos, 3);
      end;
      '(': begin
        This := 10000;
        Inc(IPos, 3);
      end;
      // die standard-numerals sind 1 char lang
      'M': begin
        This := 1000;
        Inc(IPos);
      end;
      'D': begin
        This := 500;
        Inc(IPos);
      end;
      'C': begin
        This := 100;
        Inc(IPos);
      end;
      'L': begin
        This := 50;
        Inc(IPos);
      end;
      'X': begin
        This := 10;
        Inc(IPos);
      end;
      'V': begin
        This := 5;
        Inc(IPos);
      end;
      'I': begin
        This := 1;
        Inc(IPos);
      end;
    else
      // fehlerhaft, skip
      Inc(IPos);
      Continue;
    end;
    if Current > 0 then
    begin
      // der letzte wert muss berücksichtigt werden
      if This > Current then
      begin
        // der aktuelle wert ist größer als der letzte
        // also muss der letzte abgezogen werden
        // und der aktuelle hinzuaddiert werden
        Result := Result - Current + This;
        // der atkuelle wert muss nicht in der nächsten runde berücksichtigt
        // werden
        Current := 0;
      end else begin
        // der letzte wert wird addiert
        Result := Result + Current;
        // der aktuelle wert wird notiert
        Current := This;
      end;
    end else begin
      // der aktuelle wert wird notiert
      Current := This;
    end;
  end;
  // der letzte nicht berücksichtigte wert wird addiert
  Result := Result + Current;
end;
......
Daniel W.
Ich bin nicht zurück, ich tue nur so
  Mit Zitat antworten Zitat
Daniel B
(Gast)

n/a Beiträge
 
#5

Re: Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

  Alt 12. Jul 2003, 23:06
Hallo,

noch eine Lösung von mir.
Delphi-Quellcode:
function RomanToDec4(Roman: String): LongInt;
const
  Arabics: Array[1..16] of Integer = (1000000, 100000, 10000, 1000, 900, 500, 400, 100, 90, 50, 40,
                                     10, 9, 5, 4, 1);
  Romans: Array[1..16] of String = ('{M}', '[M]', '(M)', 'M', 'CM', 'D', 'CD', 'C', 'XC', 'L',
                                   'XL', 'X', 'IX', 'V', 'IV', 'I');
var
  iFor, iLen: Integer;
  sTemp: String;
begin
  Result := 0;
  for iFor := 1 to 16 do
  begin
    iLen := Length(Romans[iFor]);
    sTemp := Copy(Roman, 1, iLen);
    while ((Length(Roman) > 0) and (sTemp = Romans[iFor])) do
    begin
      Roman := Copy(Roman, 1 +iLen, Length(Roman) -1);
      Result := Result +Arabics[iFor];
      sTemp := Copy(Roman, 1, iLen);
    end;
  end;
end;
Grüsse, Daniel
  Mit Zitat antworten Zitat
Benutzerbild von sakura
sakura

Registriert seit: 10. Jun 2002
Ort: München
11.412 Beiträge
 
Delphi 11 Alexandria
 
#6

Re: Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

  Alt 12. Jul 2003, 23:26
So, das hat mir ja keine Ruhe gegeben. Hier eine Lösung, welche meiner vorherigen sehr nahe kommt, allerdings den Roman-Numeral-String von hinten aufrollt.

Dieses Mal nur die optimierte Version. Im Vergleich zur vorhergehenden optimierten Variante liegt der Performance-Gewinn bei weit unter einem Prozent - beide sind also (fast) gleichwertig. Man nehme die, die einem besser gefalle.

Delphi-Quellcode:
function RomanToDec5Optimized(const Roman: String): LongInt;
var
  Current, This, IPos: Integer;
begin
  // endergebnis
  Result := 0;
  // current hält den letzten ermittelten wert
  Current := 0;
  This := 0;
  // jedes roman testen und verarbeiten
  // dabei merkt sich der algo, die aktuelle position im string
  // das ist schneller, als den string an und für sich zu manipulieren
  IPos := Length(Roman);
  while IPos > 0 do
  begin
    // nächstes roman holen
    case Roman[IPos] of
      // die sonder-numerals sind 3 char lang, deshalb INC(IPos, 3)
      '}': begin
        This := 1000000;
        Dec(IPos, 3);
      end;
      ']': begin
        This := 100000;
        Dec(IPos, 3);
      end;
      ')': begin
        This := 10000;
        Dec(IPos, 3);
      end;
      // die standard-numerals sind 1 char lang
      'M': begin
        This := 1000;
        Dec(IPos);
      end;
      'D': begin
        This := 500;
        Dec(IPos);
      end;
      'C': begin
        This := 100;
        Dec(IPos);
      end;
      'L': begin
        This := 50;
        Dec(IPos);
      end;
      'X': begin
        This := 10;
        Dec(IPos);
      end;
      'V': begin
        This := 5;
        Dec(IPos);
      end;
      'I': begin
        This := 1;
        Dec(IPos);
      end;
    else
      // fehlerhaft, skip
      Dec(IPos);
      Continue;
    end;
    if This < Current then
      Dec(Result, This)
    else
      Inc(Result, This);
    Current := This;
  end;
end;
......
Daniel W.
Ich bin nicht zurück, ich tue nur so
  Mit Zitat antworten Zitat
Benutzerbild von sakura
sakura

Registriert seit: 10. Jun 2002
Ort: München
11.412 Beiträge
 
Delphi 11 Alexandria
 
#7

Re: Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

  Alt 13. Jul 2003, 15:46
So, jetzt auch noch eine Variante von mir, um Dezimalzahlen in Römische umzuwandeln. Ist nicht ganz so performant, wie obige, aber unterstützt zwei zugelassene Systeme

Die Variante von Daniel B wandelt 99 in XCIX um. Das ist die verbreitetere Variante. Die für Schulen zugelassenen Tafelwerke fordern für 99 jedoch IC. Beide Varianten sind okay. Der Parameter Default unterscheidet welche Variante zurückgegeben wird. False gibt Variante 1, True Variante zwei. (99 diente hier als Beispiel!)

Delphi-Quellcode:
function DecToRoman(Decimal: Cardinal; Default: Boolean): WideString;
type
  TRelation = record
    Ch: Char;
    Vl: Cardinal;
    Check: Boolean;
  end;
const
  cRoman: array[0..6] of TRelation = (
    (Ch: 'I'; Vl: 1; Check: True),
    (Ch: 'V'; Vl: 5; Check: False),
    (Ch: 'X'; Vl: 10; Check: True),
    (Ch: 'L'; Vl: 50; Check: False),
    (Ch: 'C'; Vl: 100; Check: True),
    (Ch: 'D'; Vl: 500; Check: False),
    (Ch: 'M'; Vl: 1000; Check: False)
  );
var
  I, J: Integer;
begin
  Result := '';
  for I := High(cRoman) downto Low(cRoman) do
  begin
    while Decimal >= cRoman[I].Vl do
    begin
      Result := Result + cRoman[I].Ch;
      Dec(Decimal, cRoman[I].Vl);
    end;
    if Decimal = 0 then
      Break;
    if Default then
    begin
      if I > Low(cRoman) then
        for J := Low(cRoman) to Pred(I) do
          if cRoman[J].Check then
            if cRoman[I].Vl - cRoman[J].Vl <= Decimal then
            begin
              Result := Result + cRoman[J].Ch + cRoman[I].Ch;
              Dec(Decimal, cRoman[I].Vl - cRoman[J].Vl);
              Break;
            end;
    end else begin
      if I > Low(cRoman) then
      begin
        J := Pred(I);
        if not cRoman[J].Check then
          J := Pred(J);
        if cRoman[I].Vl - cRoman[J].Vl <= Decimal then
        begin
          Result := Result + cRoman[J].Ch + cRoman[I].Ch;
          Dec(Decimal, cRoman[I].Vl - cRoman[J].Vl);
        end;
      end;
    end;
  end;
end;
......
Daniel W.
Ich bin nicht zurück, ich tue nur so
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:38 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz