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;
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;
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;
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;
var
X: Integer;
f:text;
begin
readln(x);
if IsSmith(X) then write('TRUE') else write('FALSE');
end.
У меня вопрос: есть ли программы, которые работают быстрее???