IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Числа Смита, Нестандартное условие задачи
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 64
Пол: Мужской

Репутация: -  0  +


Видел здесь в FAQ решение для супер-чисел Смита решение в виде функций. Так вот, мне подкинули похожую задачку, только сказали чтобы делать ее без функций... Прошу помощи! wacko.gif

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



Сообщение отредактировано: Relrin -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Relrin   Числа Смита   4.11.2010 22:18
volvo   А ты в FAQ-е функцию внимательно посмотри, значени…   4.11.2010 22:53
Relrin   А ты в FAQ-е функцию внимательно посмотри, значен…   4.11.2010 22:59
volvo   Целые числа бывают РАЗНЫЕ. Разной емкости. Бывает …   4.11.2010 23:14
Relrin   [b]Добавлено через 4 мин. Неправильно. Полный к…   4.11.2010 23:46
TarasBer   > где это заменить в этом коде? Палишься. Спр…   5.11.2010 0:11
Relrin   > где это заменить в этом коде? Палишься. Сп…   5.11.2010 0:29
TarasBer   Что делает Trunc - знаешь? Вот примени этот код дл…   5.11.2010 0:38
volvo   Опять он за свое. Тебе НЕ НАДО проверять простоту …   5.11.2010 0:46
Relrin   Что делает Trunc - знаешь? Вот примени этот код д…   5.11.2010 0:47
TarasBer   > Потому что возвести в квадрат то число, из ко…   5.11.2010 0:50
Relrin   Если ты знаешь, что такое Trunc, то почему ты гов…   5.11.2010 0:54
TarasBer   > Ну, попробуй тогда сначала под корень число 2…   5.11.2010 1:04
Relrin   Ну, я немного изменил условия проверки, чтобы подх…   5.11.2010 1:29
TarasBer   22 не является полным квадратом, оно не подходит. …   5.11.2010 1:37
Relrin   22 не является полным квадратом, оно не подходит.…   5.11.2010 1:48
TarasBer   После проверки с разложением на простые множители …   5.11.2010 2:03
Relrin   После проверки с разложением на простые множители…   5.11.2010 2:16
TarasBer   Ну или не туда вставь. Я не знаю, не я же программ…   5.11.2010 2:42
Relrin   UP   5.11.2010 11:58
volvo   Следи за руками: {Теперь еще проверим,чтобы…   5.11.2010 16:39
Relrin   Полный код текущей программы Var Found,SFound …   5.11.2010 20:36
volvo   "Не верю" (С). Я программу твою правил и…   5.11.2010 21:41
Relrin   Уже все работает! Большое спасибо! :good:   6.11.2010 1:57


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 1:39
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name