Олимпиадные задачки - Страница 2

AlexZir · 04.11.2015, 08:43

Олег, +100500!

Да все задачи вполне решаемые, сложность решения заложена только в самой формулировке задачи, специально путают.

Vladimir_S · 04.11.2015, 10:53

Цитата:

Сообщение от Mr Kejik

А вообще, если хотите, ради интереса можете попробовать сделать 4-ую задачу

Ах Вы, змей-искусАтель!

Ну ладно, уж не знаю, через что, но у меня получилось так (Free Pascal) :

Код:

Var
 S,S1,Dig_S,Dig_S1:String;
 DR,Code,DD:Word;
 i,k,Dig:Byte;
 b:boolean;

Procedure DigitalRoot(Sd:String; var Sr:String; var D:Word);
var
 P:Word;
 L,j,m:Byte;
begin
 L:=Length(Sd);
 P:=0;
 for j:=1 to L do
  begin
   Val(Sd[j],m,Code);
   Inc(P,m);
  end;
 STR(P,Sr);
 D:=P;
 if P>=10 then DigitalRoot(Sr,Sr,D);
end;

Begin
 Writeln('Enter the number (up to 255 digits):');
 Readln(S);
 DigitalRoot(S,S1,DR);
 b:=false;
 i:=0;
 Repeat
  Inc(i);
  Val(S[i],Dig,Code);
  k:=10;
  repeat
   Dec(k);
   STR(DR+k,Dig_S);
   DigitalRoot(Dig_S,Dig_S1,DD);
  until ((Dig+k<10) and ((DD mod 3)=0)) or (k=1);
  if ((Dig+k<10) and ((DD mod 3)=0)) then
   begin
    b:=true;
    Dig:=Dig+k;
   end;
 Until b or (i=Length(S));
 if b then
  begin
   S1:='';
   for k:=1 to i-1 do
    S1:=S1+S[k];
   STR(Dig,Dig_S);
   S1:=S1+Dig_S;
   for k:=i+1 to Length(S) do
    S1:=S1+S[k];
  end
 else
  begin
   S1:='';
   for k:=1 to Length(S)-1 do
    S1:=S1+S[k];
   S1:=S1+'6';
  end;
 Writeln('Result:');
 Writeln(S1);
 Readln
End.

Программа "переваривает" числа длиной до 255 цифр.
На всякий случай: смысл последнего ветвления в том, чтобы обработать число, состоящее из одних девяток. В этом случае нужно последнюю девятку заменить шестёркой.
Применена рекурсивная процедура вычисления цифрового корня.

Mr Kejik · 05.11.2015, 19:34

Цитата:

Сообщение от Vladimir_S

На всякий случай: смысл последнего ветвления в том, чтобы обработать число, состоящее из одних девяток. В этом случае нужно последнюю девятку заменить шестёркой.

В тестах программу проверяли на числа не только из одних девяток, но также и из одних восьмерок - там тоже нужно понизить последнюю циферку

Ваша программа через получение строки работает?
Просто я так и не дошел - какой тип целого числа может "выдержать" 100-значное неотрицательное число (нужно около 512 байт)
Погуглим...

Mr Kejik · 05.11.2015, 19:39

Цитата:

Сообщение от Vladimir_S

Ах Вы, змей-искусАтель!
Ну ладно, уж не знаю, через что, но у меня получилось так

Спасибо большое за поддержку

Я тут занимаюсь еще изучением верстки сайтов - на свою страничку вставлю этот код - на память

Vladimir_S · 05.11.2015, 19:44

Цитата:

Сообщение от Mr Kejik

В тестах программу проверяли на числа не только из одних девяток, но также и из одних восьмерок - там тоже нужно понизить последнюю циферку

Да... не учел.

Цитата:

Сообщение от Mr Kejik

Ваша программа через получение строки работает?

Конечно.

Цитата:

Сообщение от Mr Kejik

Просто я так и не дошел - какой тип целого числа может "выдержать" 100-значное неотрицательное число (нужно около 512 байт) Погуглим...

Сколь мне известно, такого типа в природе не существует. Например, некоторые виды (не все!) ЯП Паскаль-семейства поддерживают 20-значные числа (8 байт), но это всего лишь до 18446744073709551615. Так что мне кажется, что остаются только строки.

Mr Kejik · 05.11.2015, 19:46

Цитата:

Сообщение от Vladimir_S

Так что мне кажется, что остаются только строки

Поэтому я так и сделал

Возможно чуть позже выложу свой вариант, переписанный на Паскаль с С++

Vladimir_S · 05.11.2015, 20:01

Исправил. Теперь и восьмерки отрабатывает:

Код:

Var
 S,S1,S2,Dig_S,Dig_S1:String;
 DR,Code,DD:Word;
 i,k,Dig:Byte;
 b:boolean;

Procedure DigitalRoot(Sd:String; var Sr:String; var D:Word);
var
 P:Word;
 L,j,m:Byte;
begin
 L:=Length(Sd);
 P:=0;
 for j:=1 to L do
  begin
   Val(Sd[j],m,Code);
   Inc(P,m);
  end;
 STR(P,Sr);
 D:=P;
 if P>=10 then DigitalRoot(Sr,Sr,D);
end;

Begin
 Writeln('Enter the number (up to 255 digits):');
 Readln(S);
 DigitalRoot(S,S1,DR);
 b:=false;
 i:=0;
 Repeat
  Inc(i);
  Val(S[i],Dig,Code);
  k:=10;
  repeat
   Dec(k);
   STR(DR+k,Dig_S);
   DigitalRoot(Dig_S,Dig_S1,DD);
  until ((Dig+k<10) and ((DD mod 3)=0)) or (k=1);
  if ((Dig+k<10) and ((DD mod 3)=0)) then
   begin
    b:=true;
    Dig:=Dig+k;
   end;
 Until b or (i=Length(S));
 if b then
  begin
   S1:='';
   for k:=1 to i-1 do
    S1:=S1+S[k];
   STR(Dig,Dig_S);
   S1:=S1+Dig_S;
   for k:=i+1 to Length(S) do
    S1:=S1+S[k];
  end
 else
  begin
   S1:='';
   for k:=1 to Length(S)-1 do
    S1:=S1+S[k];
   DigitalRoot(S1,S2,DR);
   Val(S[Length(S)],Dig,Code);
   repeat
    Dec(Dig);
   until ((DR+Dig) mod 3)=0;
   STR(Dig,Dig_S);
   S1:=S1+Dig_S;
  end;
 Writeln('Result:');
 Writeln(S1);
 Readln
End.

navy4ok · 05.11.2015, 20:18

Цитата:

Сообщение от Vladimir_S

всего лишь до 18446744073709551615

Владимир Игоревич, я немножко баловался ассемблером )))

Цитата:

dt — резервирование памяти для данных размером 10 байт.
Директивой dt можно задавать следующие значения:
выражение или константу, принимающую значение из диапазона:
для МП i8086:
для чисел со знаком –32 768...+32 767;
для чисел без знака 0...65 535;
для МП i386 и выше:
для чисел со знаком –2 147 483 648...+2 147 483 647;
для чисел без знака 0...4 294 967 295;
относительное или адресное выражение, состоящее из 32 или менее бит (для i80386) или 16 или менее бит (для младших моделей);
адресное выражение, состоящее из 16-битового сегмента и 32-битового смещения;
константу со знаком из диапазона –279...279-1;
константу без знака из диапазона 0...280-1;
строку длиной до 10 байт, заключенную в кавычки;
упакованную десятичную константу в диапазоне 0...99 999 999 999 999 999 999.

Отсюда.

Mr Kejik · 05.11.2015, 20:25

Вот мой С++ код, переписанный на Паскаль

Код:

var
	number : string;
	sum, ost, i, err, digit : integer;
	got : boolean;

Begin
	readln(number);
	for i := 1 to length(number) do begin
		Val(number[i], digit, err);
		sum := sum + digit;
	end;
	ost := 3 - (sum mod 3);
	got := false;
	for i := 1 to length(number) do begin
		Val(number[i], digit, err);
		if (digit <= 9-ost) and (not got) then begin
			got := true;
			digit := digit + ost;
			while digit <= 6 do digit := digit + 3;
			write(digit);
		end else begin
			if (i = length(number)) and (not got) then begin
				got := true;
				digit := digit - ost;
				write(digit);
			end else
				write(digit);
		end;
	end;
End.

Mr Kejik · 05.11.2015, 20:27

Цитата:

Сообщение от navy4ok

Владимир Игоревич, я немножко баловался ассемблером )))

Ого, я ассемблер не осилю пока ))
И все-таки не сможет С++ 100-разрядное число выдержать

04.11.2015, 08:43	#11 (permalink)
AlexZir support Регистрация: 19.08.2007 Адрес: Зея Сообщений: 15,797 Записей в дневнике: 71 Сказал(а) спасибо: 166 Поблагодарили 203 раз(а) в 86 сообщениях Репутация: 75760	Олег, +100500! Да все задачи вполне решаемые, сложность решения заложена только в самой формулировке задачи, специально путают. __________________ Убить всех человеков!

04.11.2015, 08:43
Helpmaster Member Регистрация: 08.03.2016 Сообщений: 0	Иногда для успешного решения проблемы стоит лишь обратить внимание на схожие топики Паскальчик, задачки Кто решит задачки? Три задачки Две задачки, массивы Задачки на Pascal

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070