Цитата:
Сообщение от ann55
Посчитать сумму двух натуральных чисел А и В, записанных в римской системе счисления. Ответ также записать в римской системе счисления. М = 1000, D = 500, С = 100, L = 50, X = 10, V = 5, I =1 (Все числа – не превышают 2000).
Входные данные
В строке записано два числа в римской системе счисления, между которыми стоит знак "+" .
Выходные данные
Единственное число – сумма чисел, записанное также в римской системе счисления. Числа в римской системе счисления записаны большими латинскими буквами.
|
Да... занятная такая задачка. Получите. Только сразу предупреждаю: пишу в DOS Free Pascal (он же, по сути, Turbo Pascal), а потому если у Вас этот ублюдочный АВС и он глючит, то за это я не отвечаю.
Код:
Var
T,T1,T2,T3:String;
N1,N2,N3:Word;
j,k:Byte;
Function Roma2Arab(R:String):Word;
var
i,p:Byte;
A:Word;
S:String;
begin
S:=R;
If (Length(S)>2) and (S[1]='M') and (S[2]='M') and (S[3]='M') then
begin
A:=3000;
p:=3;
end
else
If (Length(S)>1) and (S[1]='M') and (S[2]='M') then
begin
A:=2000;
p:=2;
end
else
If S[1]='M' then
begin
A:=1000;
p:=1;
end
else
begin
A:=0;
p:=0;
end;
Delete(S,1,p);
If (Length(S)>3) and (S[1]='D') and (S[2]='C') and (S[3]='C') and (S[4]='C') then
begin
A:=A+800;
p:=4;
end
else
If (Length(S)>2) and (S[1]='C') and (S[2]='C') and (S[3]='C') then
begin
A:=A+300;
p:=3;
end
else
If (Length(S)>2) and (S[1]='D') and (S[2]='C') and (S[3]='C') then
begin
A:=A+700;
p:=3;
end
else
If (Length(S)>1) and (S[1]='C') and (S[2]='C') then
begin
A:=A+200;
p:=2;
end
else
If (Length(S)>1) and (S[1]='C') and (S[2]='D') then
begin
A:=A+400;
p:=2;
end
else
If (Length(S)>1) and (S[1]='D') and (S[2]='C') then
begin
A:=A+600;
p:=2;
end
else
If (Length(S)>1) and (S[1]='C') and (S[2]='M') then
begin
A:=A+900;
p:=2;
end
else
If S[1]='D' then
begin
A:=A+500;
p:=1;
end
else
If S[1]='C' then
begin
A:=A+100;
p:=1;
end
else
p:=0;
Delete(S,1,p);
If (Length(S)>3) and (S[1]='L') and (S[2]='X') and (S[3]='X') and (S[4]='X') then
begin
A:=A+80;
p:=4;
end
else
If (Length(S)>2) and (S[1]='X') and (S[2]='X') and (S[3]='X') then
begin
A:=A+30;
p:=3;
end
else
If (Length(S)>2) and (S[1]='L') and (S[2]='X') and (S[3]='X') then
begin
A:=A+70;
p:=3;
end
else
If (Length(S)>1) and (S[1]='X') and (S[2]='X') then
begin
A:=A+20;
p:=2;
end
else
If (Length(S)>1) and (S[1]='X') and (S[2]='L') then
begin
A:=A+40;
p:=2;
end
else
If (Length(S)>1) and (S[1]='L') and (S[2]='X') then
begin
A:=A+60;
p:=2;
end
else
If (Length(S)>1) and (S[1]='X') and (S[2]='C') then
begin
A:=A+90;
p:=2;
end
else
If S[1]='L' then
begin
A:=A+50;
p:=1;
end
else
If S[1]='X' then
begin
A:=A+10;
p:=1;
end
else
p:=0;
Delete(S,1,p);
If (Length(S)>3) and (S[1]='V') and (S[2]='I') and (S[3]='I') and (S[4]='I') then
A:=A+8
else
If (Length(S)>2) and (S[1]='I') and (S[2]='I') and (S[3]='I') then
A:=A+3
else
If (Length(S)>2) and (S[1]='V') and (S[2]='I') and (S[3]='I') then
A:=A+7
else
If (Length(S)>1) and (S[1]='I') and (S[2]='I') then
A:=A+2
else
If (Length(S)>1) and (S[1]='I') and (S[2]='V') then
A:=A+4
else
If (Length(S)>1) and (S[1]='V') and (S[2]='I') then
A:=A+6
else
If (Length(S)>1) and (S[1]='I') and (S[2]='X') then
A:=A+9
else
If S[1]='V' then
A:=A+5
else
If S[1]='I' then
A:=A+1;
Roma2Arab:=A;
end;
Function Arab2Roma(N:Word):String;
var
S:String;
Q:Byte;
M:Word;
begin
M:=N;
S:='';
Q:=M div 1000;
If Q>0 then
Case Q of
1: S:=S+'M';
2: S:=S+'MM';
3: S:=S+'MMM';
end;
M:=M mod 1000;
Q:=M div 100;
If Q>0 then
Case Q of
1: S:=S+'C';
2: S:=S+'CC';
3: S:=S+'CCC';
4: S:=S+'CD';
5: S:=S+'D';
6: S:=S+'DC';
7: S:=S+'DCC';
8: S:=S+'DCCC';
9: S:=S+'CM';
end;
M:=M mod 100;
Q:=M div 10;
If Q>0 then
Case Q of
1: S:=S+'X';
2: S:=S+'XX';
3: S:=S+'XXX';
4: S:=S+'LX';
5: S:=S+'L';
6: S:=S+'LX';
7: S:=S+'LXX';
8: S:=S+'LXXX';
9: S:=S+'XC';
end;
M:=M mod 10;
If M>0 then
Case M of
1: S:=S+'I';
2: S:=S+'II';
3: S:=S+'III';
4: S:=S+'IV';
5: S:=S+'V';
6: S:=S+'VI';
7: S:=S+'VII';
8: S:=S+'VIII';
9: S:=S+'IX';
end;
Arab2Roma:=S;
end;
Begin
Write('Enter the string: ');
Readln(T);
T1:='';
T2:='';
j:=0;
Repeat
Inc(j);
If T[j]<>'+' then T1:=T1+T[j];
Until T[j]='+';
k:=j+1;
For j:=k to Length(T) do T2:=T2+T[j];
N1:=Roma2Arab(T1);
N2:=Roma2Arab(T2);
N3:=N1+N2;
Writeln('Arab form: ',N1,'+',N2);
Writeln('Result: ',Arab2Roma(N3));
Writeln('Arab form: ',N3);
Readln;
End.