Связь и интернет Архив Программирование
   
Сделать стартовойСделать закладку            
   ПОИСК  
   
Главная / Алгоритмы / Математика / Разное /
8  Perl
8  PHP
8  JavaScript
8  HTML
8  DHTML
8  XML
8  CSS
8  C / C++
8  Pascal и Delphi
8  Турбо Ассемблер
8  MySQL
8  CASE-технологии
8  Алгоритмы
8  Python
8  Обратная связь
8  Гостевая книга
Новости о мире


Перевод из арабской в римскую систему и наоборот - Программирование от RIN.RU
Перевод из арабской в римскую систему и наоборот

Алгоритм весьма прост и извлекается непосредственно из исходника.



{ 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  Обсудить в чате

 
  
  
    Copyright ©  RIN 2003 - 2004      * Обратная связь