SRL Archive - SRL Snippets

IntToRoman[function]

CynicRus

2012-12-25 02:14:24

Converts the integer to the Roman numerals.

ie: 1245 > MCCXLV:)
OldSchool style:

function IntToRoman(Value: Longint): string;
Label
  A500, A400, A100, A90, A50, A40, A10, A9, A5, A4, A1;
begin
  Result := '';
  while Value >= 1000 do begin
    DecEx(Value, 1000); Result := Result + 'M';
  end;
  if Value < 900 then goto A500
  else begin
    DecEx(Value, 900); Result := Result + 'CM';
  end;
  goto A90;
A400:
  if Value < 400 then goto A100
  else begin
    DecEx(Value, 400); Result := Result + 'CD';
  end;
  goto A90;
A500:
  if Value < 500 then goto A400
  else begin
    DecEx(Value, 500); Result := Result + 'D';
  end;
A100:
  while Value >= 100 do begin
    DecEx(Value, 100); Result := Result + 'C';
  end;
A90:
  if Value < 90 then goto A50
  else begin
    DecEx(Value, 90); Result := Result + 'XC';
  end;
  goto A9;
A40:
  if Value < 40 then goto A10
  else begin
    DecEx(Value, 40); Result := Result + 'XL';
  end;
  goto A9;
A50:
  if Value < 50 then goto A40
  else begin
    DecEx(Value, 50); Result := Result + 'L';
  end;
A10:
  while Value >= 10 do begin
    DecEx(Value, 10); Result := Result + 'X';
  end;
A9:
  if Value < 9 then goto A5
  else begin
    Result := Result + 'IX';
  end;
  Exit;
A4:
  if Value < 4 then goto A1
  else begin
    Result := Result + 'IV';
  end;
  Exit;
A5:
  if Value < 5 then goto A4
  else begin
    DecEx(Value, 5); Result := Result + 'V';
  end;
  goto A1;
A1:
  while Value >= 1 do begin
    Dec(Value); Result := Result + 'I';
  end;
end;

Without GoTo:

function IntToRoman(Value: LongInt): String;
 var
    j: Integer;
    Arabics: TIntegerArray;
    Romans: TStringArray;
 begin
   Arabics:=[1, 4,5,9,10,40,50,90,100,400,500,900,1000];
   Romans:=['I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M'];
   for j := 12 downto 0 do
   while (Value >= Arabics[j]) do begin
    Value := Value - Arabics[j];
    Result := Result + Romans[j];
   end;
 end;

function RomanToInt(const Value: string): integer;
var
  i, lastValue, curValue: integer;
begin
  Result := 0;
  lastValue := 0;
  for i := Length(Value) downto 1 do
  begin
   case UpperCase(Value[i]) of
   'C':
   curValue := 100;
   'D':
   curValue := 500;
   'I':
   curValue := 1;
   'L':
   curValue := 50;
   'M':
   curValue := 1000;
   'V':
   curValue := 5;
   'X':
   curValue := 10;
   else
   begin
   WriteLn('Invalid character: '+ toStr(Value[i]));
   Exit;
   end
   end;
   if curValue < lastValue then
   DecEx(Result, curValue)
   else
   IncEx(Result, curValue);
   lastValue := curValue;
  end;
end;

Sin

2012-12-25 02:18:26

Haha that's epic!

Le Jingle

2012-12-25 02:23:32

What about the value for 50 :/
However, very creative! This is a great snippet, maybe one day it'll become include if its used a lot :]

CynicRus

2012-12-25 02:29:45

From: Le Jingle
What about the value for 50 :/
However, very creative! This is a great snippet, maybe one day it'll become include if its used a lot :]


Compiled successfully in 31 ms.
L
Successfully executed

DannyRS

2012-12-25 02:34:47

Today i learned how to use a switch statement in pascal :)

Lol, very cool Cynic

CynicRus

2012-12-25 02:47:35

From: DannyRS
Today i learned how to use a switch statement in pascal :)

Lol, very cool Cynic


The function is written in OldS&#1089;hool style:) It turns out the operator "GoTo" works in Simba:)

Le Jingle

2012-12-25 03:16:42

From: CynicRus
Compiled successfully in 31 ms.
L
Successfully executed


Yay thanks!
off topic : there's been some 'roman numeral' for crossword puzzles I've been doing :p

CynicRus

2012-12-25 03:32:43

:-)

Sin

2012-12-25 03:48:58

Labels are awesome, your way is much cleaner, but I'm sorta partial to labels haha.

slushpuppy

2012-12-25 05:22:21

Nice code but a more elegant solution can probably be found using arrays and modulus divisor

Echo_

2012-12-25 23:53:43

goto is ewww.

function IntToRoman(Value: LongInt): string;
begin
  Result := '';
  while Value <> 0 do begin
    if Value >= 1000 then begin
      DecEx(Value, 1000);
      Result := Result + 'M';
      Continue;
    end;

    if Value >= 900 then begin
      DecEx(Value, 900);
      Result := Result + 'CM';
      Continue;
    end;

    if Value >= 500 then begin
      DecEx(Value, 500);
      Result := Result + 'D';
      Continue;
    end;

    if Value >= 400 then begin
      DecEx(Value, 400);
      Result := Result + 'CD';
      Continue;
    end;

    if Value >= 100 then begin
      DecEx(Value, 100);
      Result := Result + 'C';
      Continue;
    end;

    if Value >= 90 then begin
      DecEx(Value, 90);
      Result := Result + 'XC';
      Continue;
    end;

    if Value >= 50 then begin
      DecEx(Value, 50);
      Result := Result + 'L';
      Continue;
    end;

    if Value >= 40 then begin
      DecEx(Value, 40);
      Result := Result + 'XL';
      Continue;
    end;

    if Value >= 10 then begin
      DecEx(Value, 10);
      Result := Result + 'X';
      Continue;
    end;

    if Value >= 9 then begin
      DecEx(Value, 9);
      Result := Result + 'IX';
      Continue;
    end;

    if Value >= 5 then begin
      DecEx(Value, 5);
      Result := Result + 'V';
      Continue;
    end;

    if Value >= 4 then begin
      DecEx(Value, 4);
      Result := Result + 'IV';
      Continue;
    end;

    if Value >= 1 then begin
      DecEx(Value, 1);
      Result := Result + 'I';
      Continue;
    end;
  end;
end;

riwu

2012-12-26 00:36:24

Ha an efficiency competition:

function IntToRoman(Value: LongInt): string;
var
  TIA: TIntegerArray;
  TSA: TStringArray;
  i: Integer;
begin
  Result := '';
  TIA:= [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1];
  TSA:= ['M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I'];

  while Value <> 0 do
    for i:=0 to High(TIA) do
      if (Value >= TIA[i]) then
      begin
        DecEx(Value, TIA[i]);
        Result:= Result + TSA[i];
        Break; //more efficient?
      end;
end;



TIA can be generated with

procedure GenerateSequence;
var
  i, k, l, n: Integer;
  TIA: TIntegerArray;
begin
  TIA:= [1000, 900, 500, 400];
  l:= High(TIA);
  for k:=1 to 3 do
    for i:=0 to l do
    begin
      n:= TIA[i] / Round(pow(10.0, StrToFloat(ToStr(k))));
      if n > 0 then
      begin
        SetLength(TIA, Length(TIA) + 1);
        TIA[High(TIA)]:= n;
      end;
    end;
  writeln(TIA);
end;
But meh for such a small data.


What would be a practical use of this function though?

Le Jingle

2012-12-26 00:43:33

Oh, nice remakes you two ^^ ;p

Could be used for something fun like version title in script,
Ex. CynicRus Power Miner XIV

or something where people want to write a guide/long contract paper/etc. (in simba or other languages that don't have this method supported) that requires many indexed roman numeral references.

Echo_

2012-12-26 00:46:01

From: riwu
Ha an efficiency competition:

function IntToRoman(Value: LongInt): string;
var
  TIA: TIntegerArray;
  TSA: TStringArray;
  i: Integer;
begin
  Result := '';
  TIA:= [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1];
  TSA:= ['M', 'CM', 'D', 'CD', 'C', 'XC', 'L', 'XL', 'X', 'IX', 'V', 'IV', 'I'];

  while Value <> 0 do
    for i:=0 to High(TIA) do
      if (Value >= TIA[i]) then
      begin
        DecEx(Value, TIA[i]);
        Result:= Result + TSA[i];
        Break; //more efficient?
      end;
end;



TIA can be generated with

procedure GenerateSequence;
var
  i, k, l, n: Integer;
  TIA: TIntegerArray;
begin
  TIA:= [1000, 900, 500, 400];
  l:= High(TIA);
  for k:=1 to 3 do
    for i:=0 to l do
    begin
      n:= TIA[i] / Round(pow(10.0, StrToFloat(ToStr(k))));
      if n > 0 then
      begin
        SetLength(TIA, Length(TIA) + 1);
        TIA[High(TIA)]:= n;
      end;
    end;
  writeln(TIA);
end;
But meh for such a small data.


What would be a practical use of this function though?


Damn, should have thought of using a for loop :duh:

CynicRus

2012-12-26 01:05:29

Since the conversation went on optimization, to offer you these version:

function IntToRoman(Value: LongInt): String;
 var
    j: Integer;
    Arabics: TIntegerArray;
    Romans: TStringArray;
 begin
   Arabics:=[1, 4,5,9,10,40,50,90,100,400,500,900,1000];
   Romans:=['I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M'];
   for j := 12 downto 0 do
   while (Value >= Arabics[j]) do begin
    Value := Value - Arabics[j];
    Result := Result + Romans[j];
   end;
 end;

And reverse conversion:

function RomanToInt(const Value: string): integer;
var
  i, lastValue, curValue: integer;
begin
  Result := 0;
  lastValue := 0;
  for i := Length(Value) downto 1 do
  begin
   case UpperCase(Value[i]) of
   'C':
   curValue := 100;
   'D':
   curValue := 500;
   'I':
   curValue := 1;
   'L':
   curValue := 50;
   'M':
   curValue := 1000;
   'V':
   curValue := 5;
   'X':
   curValue := 10;
   else
   begin
   WriteLn('Invalid character: '+ toStr(Value[i]));
   Exit;
   end
   end;
   if curValue < lastValue then
   DecEx(Result, curValue)
   else
   IncEx(Result, curValue);
   lastValue := curValue;
  end;
end;

IsoMorphic

2013-01-01 04:34:48

Sorry, but what is the point of this?

Ashaman88

2013-01-01 09:26:26

From: IsoMorphic
Sorry, but what is the point of this?


I believe it is to convert integers to roman numerals.


Very interesting!