Задача Паскаль

[ann55]

Задача Паскаль

Посчитать сумму двух натуральных чисел А и В, записанных в римской системе счисления. Ответ также записать в римской системе счисления. М = 1000, D = 500, С = 100, L = 50, X = 10, V = 5, I =1 (Все числа – не превышают 2000).
Входные данные
В строке записано два числа в римской системе счисления, между которыми стоит знак "+" .
Выходные данные
Единственное число – сумма чисел, записанное также в римской системе счисления. Числа в римской системе счисления записаны большими латинскими буквами.

 

[ann55]

и еще одна
Зная значение N! (N!=1*2*...*(N-1)*N) определить значение N.

Входные данные В единственной строке находится значение N! (1 ≤ N ≤ 2000).
Выходные данные
Вывести значение натурального числа N.

 

[Vladimir_S]

Посчитать сумму двух натуральных чисел А и В, записанных в римской системе счисления. Ответ также записать в римской системе счисления. М = 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.

 

[Vladimir_S]

и еще одна
Зная значение N! (N!=1*2*...*(N-1)*N) определить значение N.

Входные данные В единственной строке находится значение N! (1 ≤ N ≤ 2000).
Выходные данные
Вывести значение натурального числа N.

Ну, это совсем тривиально и нисколько не интересно.

Var
 i,N,P:Longint;
Begin
 Write('N! = ');
 Readln(N);
 i:=1;
 P:=1;
 Repeat
  Inc(i);
  P:=P*i;
 Until P=N;
 Writeln('N = ',i);
 Readln;
End.