Найти число, сумма делителей которого в три раза больше самого числа - QBasic

Формулировка задачи:

Найти число, сумма делителей которого в три раза больше самого числа (Само число к делителям не относится) Программа нашла наименьшее из таких чисел - 30240 примечание Тут бейсику пришлось посчитать. Вероятнее всего он никогда не найдет числа, сумма делителей которого в 4 раза, (в 5 раз) больше самого числа...
REM
REM  30240
REM
 
DECLARE FUNCTION f! (n!)
 
CLS
 
FOR i = 1000 TO 31000
   IF f(i) = 3 * i THEN PRINT i;
NEXT
END
 
FUNCTION f (n)
   FOR i = 1 TO n \ 2
      IF n MOD i = 0 THEN s = s + i
   NEXT i
   f = s
END FUNCTION

Код к задаче: «Найти число, сумма делителей которого в три раза больше самого числа - QBasic»

textual
{$mode objfpc}
uses windows;
 
type
   Tlong = qword;
 
const
   n = 50;
 
var
  f : array [1 .. n] of
  record
    mult  : integer;
    power : integer;
  end;
 
// I variant
function ds(i : longint) : longint;
var j : longint;
begin
  result := 0;
  for j := 1 to i div 2 do
    if i mod j = 0 then result := result + j;
end;
 
 
procedure Add(i : integer);
var
   j : integer;
   found : boolean;
begin
   found := false; j := 1;
   while (j <= n) and (f[j].mult > 0) and (not found) do
      if f[j].mult = i then
      begin
         inc(f[j].power); found := true;
      end
      else inc(j);
 
   if not found then
   begin
      f[j].mult := i; f[j].power := 1;
   end;
end;
 
function Factorization(x : Tlong) : Tlong;
var i : Tlong;
 
   procedure DivX;
   begin
      while (x > 1) and (x mod i = 0) do
      begin
         Add(i); x := x div i;
      end;
   end;
 
var
  j, k : integer;
  t, s : Tlong;
 
begin
   i := 2;
   DivX;
   i := 3;
   while i < x div 2 do
   begin
      DivX;
      inc(i,2);
   end;
   if x > 1 then Add(x);
 
   k := 1;
   result := 1;
   while (k <= n) and (f[k].mult > 0) do
   begin
      // write(f[k].mult, '^', f[k].power, ' ');
 
      t := 1; s := 1;
      for j := 1 to f[k].power do
      begin
         t := t * f[k].mult;
         s := s + t;
      end;
      result := result * s;
      inc(k);
   end;
end;
 
var
   p, num : Tlong;
   i : integer;
 
   tm : dword;
begin
   tm := gettickcount;
   num := 2;
   repeat
      inc(num, 2);
      FillByte(f, sizeof(f), 0); // обнуляем массив структур
      p := Factorization(num);
   until(p = 4 * num);
   writeln(num, ': sum of divisors = ', p, ' vs ', 4 * num);
   writeln('time = ', gettickcount - tm);
 
   // сравниваем с твоим методом вычисления суммы делителей
   tm := gettickcount;
   for i := 1 to 20000 do
   if ds(2*i) = 3 * 2*i then
   begin
      writeln(2*i); break;
   end;
   writeln('time = ', gettickcount - tm);
 
   readln;
end.

13   голосов, оценка 3.846 из 5


СОХРАНИТЬ ССЫЛКУ