[fpc-pascal] Re: StrUtils.RomanToInt oddities

[Lukasz Sokol]

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
>