Чуть не забыл, про условие задачи: Составное число называется числом Смита, если сумма его цифр равна сумме цифр всех чисел, образующихся разложением исходного числа на простые множители. Число Смита называется супер-числом Смита, если сумма его цифр является числом смита. Найти супер-число Смита с номером N, являющееся полным квадратом. (Число называется полным квадратом, если корень квадратный из него является простым числом)
Проблема в коде ниже в том, что у меня находит числа до 6(N=6) включительно, а это число 10201, а дальше не хватает "числового пространства". Плюс смущает его получение числа из под корня... Из числа 22, или 202 или 1111, например, как результаты поиска таких супер-чисел, целое число не получается, но его программа считает как целое...
Мое решение:
Var
Found,SFound : boolean; {Флаг для цикла}
simple : boolean; {Флаг, используемый при проверке на пр. число}
square : double; {Переменная,в котором хранится число из кв. корня}
number,numb : integer; {Число,с которого начинаем поиск...}
N : integer; {Наше супер-число Смита}
i,j,k : integer; {Счетчики для циклов}
Smith, SSmith : integer; {Искомое супер-число Смита}
SumNumb : integer; {Сумма цифр числа}
SumSubs : integer; {Сумма множителей}
amount : integer; {Кол-во простых множителей}
numSum,numSub : integer; {Переменные для поиска сумм}
factor,pr : integer; {Начальный делитель числа}
s,sfact,sum : integer; {Результат вычислений}
Begin
{ВВОД ЧИСЛА N}
write('Enter your number N: ');
readln(N);
{Поиск супер-числа Смита}
i:=0;
number:=1;
while i<>N do
begin
repeat
SFound:=false;
{Поиск числа Смита}
repeat
inc(number);
Found:=false;
SumNumb:=0;
SumSubs:=0;
numSum:=number;
numSub:=number;
{Подсчет суммы цифр числа}
s:=0;
while numSum<>0 do
begin
inc(s,numSum mod 10);
numSum:=numSum div 10;
end;
SumNumb:=s;
{Подсчет суммы множителей числа}
s:=0;
factor:=2;
amount:=0;
repeat
if (numSub mod factor)=0 then
begin
{Подсчитываем сумму цифр числа (множителя)}
sfact:=0;
numb:=factor;
while numb<>0 do
begin
inc(sfact,numb mod 10);
numb:=numb div 10;
end;
sum:=sfact;
{Подсчитываем сумму множителей}
s:=s+sum;
inc(amount);
numSub:=numSub div factor
end
else inc(factor);
until numSub=1;
SumSubs:=s;
{Найденное число - это число Смита?}
{Проверяем, чтобы сумма его цифр была равна сумме простых множителей}
if ((SumNumb=SumSubs) and (amount>1)) then Found:=true;
until Found=true;
{Поиск супер-чисел Смита, удолетворяющих условиям}
{Подсчет суммы цифр cупер-числа Смита}
s:=0;
numSum:=0;
numSum:=number;
while numSum<>0 do
begin
inc(s,numSum mod 10);
numSum:=numSum div 10;
end;
SSmith:=s;
{Проверка на супер-число Смита}
SumNumb:=0;
SumSubs:=0;
numSum:=SSmith;
numSub:=SSmith;
{Подсчет суммы цифр числа}
s:=0;
while numSum<>0 do
begin
inc(s,numSum mod 10);
numSum:=numSum div 10;
end;
SumNumb:=s;
{Подсчет суммы множителей числа}
s:=0;
factor:=2;
amount:=0;
repeat
if (numSub mod factor)=0 then
begin
{Подсчитываем сумму цифр числа (множителя)}
sfact:=0;
numb:=factor;
while numb<>0 do
begin
inc(sfact,numb mod 10);
numb:=numb div 10;
end;
sum:=sfact;
{Подсчитываем сумму множителей}
s:=s+sum;
inc(amount);
numSub:=numSub div factor
end
else inc(factor);
until numSub=1;
SumSubs:=s;
{Теперь еще проверим,чтобы это из корня кв. было простым числом}
square:=sqrt(SSmith);
simple:=true;
if frac(square)=0 then
begin
simple:=true;
for j:=2 to round(sqrt(square)) do
if (round(square) mod j)=0 then simple:=false;
end
else simple:=false;
{Найденное число - это супер-число Смита?}
{Проверяем, чтобы сумма его цифр являлась числом Смита}
if ((SumNumb=SumSubs) and (amount>1) and (simple=true)) then SFound:=true;
until SFound=true;
inc(i);
end;
Smith:=number;
{ВЫВОД СУПЕР-ЧИСЛА СМИТА}
writeln('Ваше супер-число Смита: ',Smith);
readln;
End.
