Dezimalzahlen in Römische Zahlen umwandeln und umgekehrt

[Daniel B]

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

[Daniel B]

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

[Daniel B]

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

[sakura]

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 B]

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

[sakura]

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;

......

[sakura]

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;

......