Замечательные числа Опции

[volvo]

Числа и СуперЧисла Смита

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

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

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

{
   Функция для подсчета суммы цифр числа 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 IsSmith(n: LongInt): Boolean;
var
   Amount: integer;
begin
   IsSmith :=
      (GetOneDigits(n) = GetSimpleDigits(n, Amount))
      and
      (Amount > 1)
end;

{
   Функция возвращает N-ное число Смита
   PrevN - номер предыдущего числа Смита, найденного этой функцией
   (при первом вызове параметр PrevN должен быть равен 0)

   PrevSmith - предыдущее число Смита, найденное этой функцией
   (при первом вызове параметр PrevSmith должен быть равен 2)
}
function GetSmith(n: Integer; PrevN: integer;
         StartCount: longint): LongInt;
var
	i: Integer;
	count: LongInt;
begin
   i := PrevN;
   count := StartCount;

   while i <> n do
   begin
      repeat
         Inc(count);
      until IsSmith(count);
      Inc(i);
   end;
   GetSmith := Count
end;

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

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

   Writeln(GetSmith(1000, 0, 2));
end.

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

Сообщение отредактировано: volvo - 6.11.2010 17:47

[volvo]

Числа Армстронга

Число Армстронга - такое число из k цифр, для которого сумма k-х степеней его цифр равна самому этому числу, например 153=1^3 +5^3 +3^3

Ниже приведены две функции для работы с числами Армстронга:

• Function IsArmstrong(n: LongInt): Boolean;
  Возвращает True если переданное ей в качестве аргумента число является числом Армстронга
• Procedure GetArmstrongs(n: integer);
  Распечатывает все n-значные числа Армстронга

function Power(n, k: Integer): LongInt;
var
	p: LongInt; i: Word;
begin
	p := 1;
	for i := 1 to k do p := p * n;
	Power := p
end;

function IsArmstrong(n: LongInt): Boolean;
var
	Weight: array[0 .. 9] of LongInt;
	i, j: Integer; s: LongInt;
begin
	i := -1; s := n;
	while s > 0 do begin
		Inc(i);
		Weight[i] := s mod 10;
		s := s div 10
	end;
	
	for j := 0 to i do
		s := s + Power(Weight[j], Succ(i));
	
	IsArmstrong := (s = n)
end;
	
procedure GetArmstrongs(n: integer);
var
	Weight: array[0 .. 9] of LongInt;
	k, x, min, max, s, p: LongInt;
begin
	for k := 0 to 9 do
		Weight[k] := Power(k, n);
	min := Power(10, Pred(n));
	max := Pred(10 * min);
	
	for x := min to max do begin
		p := x; s := 0;
		for k := 1 to n do begin
			Inc(s, Weight[p mod 10]);
			p := p div 10
		end;
		
		if s = x then WriteLn(x, ' - Armstrong')
	end;
end;

{
	Пример использования
}
var
	n: 1 .. 9;
begin
	repeat
		Write('n [1 .. 9] = '); ReadLn(n)
	until n in [1 .. 9];
	GetArmstrongs(n);
		
	WriteLn('1741725: ', isArmstrong(1741725))
end.