Технический форум

Технический форум (http://www.tehnari.ru/)
-   Delphi, Kylix and Pascal (http://www.tehnari.ru/f43/)
-   -   Задача Паскаль (http://www.tehnari.ru/f43/t82019/)

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

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

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

Vladimir_S 12.12.2012 11:15
Цитата:
Сообщение от ann55 (Сообщение 832301)
Посчитать сумму двух натуральных чисел А и В, записанных в римской системе счисления. Ответ также записать в римской системе счисления. М = 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 12.12.2012 11:28
Цитата:
Сообщение от ann55 (Сообщение 832306)
и еще одна
Зная значение 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.


Часовой пояс GMT +4, время: 05:24.

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.