Алгоритм весьма прост и извлекается непосредственно из исходника.
{ Copyright MM Andrew Usachov }
Const
R: Array[1..13] of String[2] =
('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
A: Array[1..13] of Integer=
(1,4,5,9,10,40,50,90,100,400,500,900,1000);
Function Roman(N : Integer) : String;
Var Result : String;
i : Integer;
begin
Result := '';
i := 13;
While N >0 do
begin
While A[i] >N do Dec(i);
Result := Result + R[i];
Dec(N, A[i]);
end;
Roman := Result;
end;
Function Arabic(S : String) : Integer;
Var Result : Integer;
i, p : Integer;
begin
Arabic := -1;
Result := 0;
i := 13;
p := 1;
While p <=Length(S) do
begin
While Copy(S, p, Length(R[i])) <>R[i] do
begin
Dec(i);
If i = 0 then Exit;
end;
Result := Result + A[i];
p := p + Length(R[i]);
end;
If Roman(Result) = S then Arabic := Result
end;
Var N, Err : Integer;
S : String;
BEGIN
repeat
ReadLn(S);
If S = '' then Break;
Val(S, N, Err);
If Err = 0 then
WriteLn(Roman(N))
else
WriteLn(Arabic(S));
until false;
END.
8 8 8
| 
*
Обратная связь