[fpc-pascal] Re: StrUtils.RomanToInt oddities
Lukasz Sokol
el.es.cr at gmail.com
Mon Sep 23 11:44:02 CEST 2013
On 20/09/13 19:49, Bart wrote:
> On 9/20/13, Reinier Olislagers <reinierolislagers at gmail.com> wrote:
>
>> The question however becomes "what is the
>> algorithm for deciding invalid characters" which IMO will become a mess
>> very quickly. Much better to just consider the entire input as invalid.
>>
>
> Here's my implementation:
Here is how I would write it ;)
function TryRomanToInt(AInput:String; out AResult: integer):boolean;
var i, Len, N, Np1 : integer;
function TryRomanCharToInt(AIn: Char; out AOut: integer): boolean;
begin
case AIn of
'M' : AOut := 1000;
'D' : AOut := 500;
'C' : AOut := 100;
'L' : AOut := 50;
'X' : AOut := 10;
'V' : AOut := 5;
'I' : AOut := 1;
else
AOut := 0;
end;
Result := (AOut > 0);
end;
begin
// if it looks like shameless c&p, it's because it is ;)
Result := False;
AInput := UpperCase(AInput); //don't use AnsiUpperCase please
Len := Length(AInput);
if (Len = 0) then Exit;
//
i := 1;
for i := 1 to Len-1 do
begin
if not TryRomanCharToInt(AInput[i], N) then
begin
AResult := -1; // invalidate everything
exit;
// writeln('Not a valid roman numeral at position ',i);
end;
if (i > Len -1) then
begin
if not TryRomanCharToInt(AInput[i+1], Np1) then
begin
AResult := -1; // invalidate everithing
exit;
// writeln('Not a valid roman numeral at position ',i+1);
end;
// according to wikipedia, wonder if these are hard or soft rules thou...
if not (((N = 100) and (Np1 > 100)) or // C can be placed before L or M
((N = 10) and (Np1 > 10) and (Np1 <= 100)) or // X can be placed before L or C
((N = 1) and (Np1 > 1) and (Np1 <= 10))) // I can be placed before V and X
then
begin
AResult := -1; // invalidate everithing: catches MDCLXVIVXLDM
exit;
// writeln('Not a valid roman numeral combination at position ',i, ' and ',i+1);
end;
if N >= Np1 then AResult := AResult + N
else AResult := AResult - N;
end;
else // i = Len-1 = last char we just add (consider : MCM : add 1000, sub 100, add 1000 = 1900)
begin
AResult := AResult + N;
end;
end; // for
// if the above, after all characters are through, has resulted in 0 or less,
// we invalidate everything at the end (consider : CMLM, IIIM )
Result := AResult > 0;
if not Result then AResult := 0;
end;
(only mind-compiled ;) tests welcome ;) )
-L
>
> program test;
>
> {$mode objfpc}
> {$H+}
>
> uses
> SysUtils, StrUtils;
>
>
> function TryRomanToInt(S: String; out N: Integer): Boolean;
> var
> i, Len: Integer;
> Terminated: Boolean;
> begin
> Result := (False);
> S := UpperCase(S); //don't use AnsiUpperCase please
> Len := Length(S);
> if (Len = 0) then Exit;
> i := 1;
> N := 0;
> Terminated := False;
> //leading M's
> while (i <= Len) and (S[i] = 'M') do
> begin
> //writeln('TryRomanToInt: Found 1000');
> Inc(i);
> N := N + 1000;
> end;
> //then CM or or CD or D or (C, CC, CCC, CCCC)
> if (i <= Len) and (S[i] = 'D') then
> begin
> //writeln('TryRomanToInt: Found 500');
> Inc(i);
> N := N + 500;
> end
> else if (i + 1 <= Len) and (S[i] = 'C') then
> begin
> if (S[i+1] = 'M') then
> begin
> //writeln('TryRomanToInt: Found 900');
> Inc(i,2);
> N := N + 900;
> end
> else if (S[i+1] = 'D') then
> begin
> //writeln('TryRomanToInt: Found 400');
> Inc(i,2);
> N := N + 400;
> end;
> end ;
> //next max 4 C's
> if (i <= Len) and (S[i] = 'C') then
> begin
> //find max 4 C's
> //writeln('TryRomanToInt: Found 100');
> Inc(i);
> N := N + 100;
> if (i <= Len) and (S[i] = 'C') then
> begin
> //writeln('TryRomanToInt: Found 100');
> Inc(i);
> N := N + 100;
> end;
> if (i <= Len) and (S[i] = 'C') then
> begin
> //writeln('TryRomanToInt: Found 100');
> Inc(i);
> N := N + 100;
> end;
> if (i <= Len) and (S[i] = 'C') then
> begin
> //writeln('TryRomanToInt: Found 100');
> Inc(i);
> N := N + 100;
> end;
> end;
>
> //then XC or XL
> if (i + 1 <= Len) and (S[i] = 'X') then
> begin
> if (S[i+1] = 'C') then
> begin
> //writeln('TryRomanToInt: Found 90');
> Inc(i,2);
> N := N + 90;
> end
> else if (S[i+1] = 'L') then
> begin
> //writeln('TryRomanToInt: Found 40');
> Inc(i,2);
> N := N + 40;
> end;
> end;
>
> //then L
> if (i <= Len) and (S[i] = 'L') then
> begin
> //writeln('TryRomanToInt: Found 50');
> Inc(i);
> N := N + 50;
> end;
>
> //then (X, xx, xxx, xxxx)
> if (i <= Len) and (S[i] = 'X') then
> begin
> //find max 4 X's
> //writeln('TryRomanToInt: Found 10');
> Inc(i);
> N := N + 10;
> if (i <= Len) and (S[i] = 'X') then
> begin
> //writeln('TryRomanToInt: Found 10');
> Inc(i);
> N := N + 10;
> end;
> if (i <= Len) and (S[i] = 'X') then
> begin
> //writeln('TryRomanToInt: Found 10');
> Inc(i);
> N := N + 10;
> end;
> if (i <= Len) and (S[i] = 'X') then
> begin
> //writeln('TryRomanToInt: Found 10');
> Inc(i);
> N := N + 10;
> end;
> end;
>
> //then IX or IV
> if (i + 1 <= Len) and (S[i] = 'I') then
> begin
> if (S[i+1] = 'X') then
> begin
> Terminated := (True);
> //writeln('TryRomanToInt: Found 9');
> Inc(i,2);
> N := N + 9;
> end
> else if (S[i+1] = 'V') then
> begin
> Terminated := (True);
> //writeln('TryRomanToInt: Found 4');
> Inc(i,2);
> N := N + 4;
> end;
> end;
>
> //then V
> if (not Terminated) and (i <= Len) and (S[i] = 'V') then
> begin
> //writeln('TryRomanToInt: Found 5');
> Inc(i);
> N := N + 5;
> end;
>
>
> //then I
> if (not Terminated) and (i <= Len) and (S[i] = 'I') then
> begin
> Terminated := (True);
> //writeln('TryRomanToInt: Found 1');
> Inc(i);
> N := N + 1;
> //Find max 3 closing I's
> if (i <= Len) and (S[i] = 'I') then
> begin
> //writeln('TryRomanToInt: Found 1');
> Inc(i);
> N := N + 1;
> end;
> if (i <= Len) and (S[i] = 'I') then
> begin
> //writeln('TryRomanToInt: Found 1');
> Inc(i);
> N := N + 1;
> end;
> if (i <= Len) and (S[i] = 'I') then
> begin
> //writeln('TryRomanToInt: Found 1');
> Inc(i);
> N := N + 1;
> end;
> end;
>
> //writeln('TryRomanToInt: Len = ',Len,' i = ',i);
> Result := (i > Len);
> //if Result then writeln('TryRomanToInt: N = ',N);
>
> end;
>
> var
> S: String;
> N1, N2: Integer;
> B: Boolean;
>
> begin
> repeat
> write('Enter Roman numeral: ');
> readln(S);
> B := TryRomanToInt(S, N1);
> if B then
> write('TryRomanToInt(''',S,''') -> ',N1)
> else
> write('TryRomanToInt(''',S,''') FAIL');
> writeln;
> N2 := StrUtils.RomanToInt(S);
> writeln('StrUtils.RomanToInt(''',S,''') = ',N2);
> if B and (N1 <> N2) then writeln('StrUtils.RomanToInt <> TryRomanToInt');
> writeln;
> until S = '';
> end.
>
> Bart
> _______________________________________________
> fpc-pascal maillist - fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal
>
More information about the fpc-pascal
mailing list