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

> Внимание! Действует предмодерация

Подраздел FAQ (ЧАВО, ЧАстые ВОпросы) предназначен для размещения готовых рабочих программ, реализаций алгоритмов. Это нечто вроде справочника, он наполнялся в течение 2000х годов. Ваши вопросы, особенно просьбы решить задачу, не пройдут предмодерацию. Те, кто наполнял раздел, уже не заходят на форум, а с теми, кто на форуме сейчас, лучше начинать общение в других разделах. В частности, решение задач — здесь.

> Замечательные числа
сообщение
Сообщение #1


Гость






Числа и СуперЧисла Смита
Цитата
Составное число называется Числом Смита, если сумма его цифр равна сумме всех чисел, образующихся разложением исходного числа на простые множители. Число Смита называется СуперЧислом Смита, если сумма его цифр является Числом Смита.


Приведенная ниже программа ищет СуперЧисло Смита с номером X...
{
Функция для подсчета суммы цифр числа N
}
function GetOneDigits(n: LongInt): Integer;
var s: Integer;
begin
s := 0;
while n <> 0 do begin
Inc(s, n mod 10);
n := n div 10;
end;
GetOneDigits := s
end;

{
Эта функция считает сумму цифр разложения исходного числа N
на простые множители и возвращает в Amount число простых множителей
}
function GetSimpleDigits(n: LongInt; var amount: Integer): Integer;
var
s, factor: Integer;
begin
s := 0; factor := 2;
amount := 0;
repeat
if n mod factor = 0 then begin
s := s + GetOneDigits(factor); Inc(amount);
n := n div factor
end
else Inc(factor)
until n = 1;
GetSimpleDigits := s
end;

{
Функция возвращает N-ное число Смита
}
function GetSmith(n: Integer): LongInt;
var
i, amount: Integer; od, sd: Integer;
count: LongInt;
Found: Boolean;
begin
i := 0; count := 2;
while i <> n do begin
repeat
Inc(count);
Found :=
(GetOneDigits(count) = GetSimpleDigits(count, amount))
and
(amount > 1)
until Found;
Inc(i)
end;
GetSmith := Count
end;

{
Функция проверяет, является ли N числом Смита
}
function IsSmith(n: LongInt): Boolean;
var
i: Integer;
next: LongInt;
begin
i := 0;
repeat
Inc(i); next := GetSmith(i)
until next >= n;
IsSmith := (next = n)
end;

{
Функция возвращает N-ное суперчисло Смита
}
function Super(n: Integer): LongInt;
var
i, count: Integer;
smith: LongInt;
Found: Boolean;
begin
i := 0; count := 0;
while i <> n do begin
Inc(i);
repeat
Inc(count);
smith := GetSmith(count);
Found := IsSmith( GetOneDigits(smith) );
until Found;
end;
Super := smith
end;

var
X: Integer;
{
Пример использования:
}
begin
Write('X = '); ReadLn(X);
WriteLn('Smith super number (X) = ', Super(X));
end.


**********

Update: поскольку вышеприведенная функция поиска Суперчисел Смита работает очень медленно - выкладываю обновленную версию:

Спойлер (Показать/Скрыть)

Немного информации о скорости работы:
СуперСмит5. Старая версия: 62 мс., новая: 1 мс.
СуперСмит100. Старая версия: 7653 мс., новая: 63 мс.
СуперСмит200. Старая версия: 43891 мс., новая: 220 мс.

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гость






Определить, является ли число палиндромом (без его преобразования в строку)

Собираем из заданного числа "обратное" ему (с цифрами, записанными в обратном порядке), и проверяем заданное и "обратное" на равенство друг другу...
function is_palindrom(x: longint): boolean;
var prev, T: longint;
begin
prev := x;
T := 0;
while x <> 0 do begin
T := T * 10 + (x mod 10);
x := x div 10;
end;

is_palindrom := (prev = T)
end;
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





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