Цитата:
Сообщение от 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 цифр.
На всякий случай: смысл последнего ветвления в том, чтобы обработать число, состоящее из одних девяток. В этом случае нужно последнюю девятку заменить шестёркой.
Применена рекурсивная процедура вычисления цифрового корня.