Процедуры и функции. Делфи7.

[Fatalita]

Помогите дописать программу.
Даны натуральное число n, целые числа a1,a2,...,an. Рассмотреть отрезки последовательности a1,a2,...,an. (последовательности идущих подряд членов) состоящих из совершенных чисел. В каждом случае получить наибольшую из длин рассматриваемых отрезков. (Определить функции, позволяющие распознать совершенные числа.)

Спасибо. Очень выручите.

Начала, а как дальше?

program n_9_14_g;

{$APPTYPE CONSOLE}

uses
  SysUtils;
  function Perfect(n:longint):boolean;
  var
  i,s:longint;
begin
  s:=0;
  for i:=1 to n div 2 do
    if n mod i = 0 then
      s:=s+i;
  result:= n=s;
end;
  var
    A: array[1..100] of Real;
    n, i: Integer;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  write('n=');
  Readln(n);
  for i:=1 to n do
    begin
      write('A[',i,']=');
      Readln(A[i]);
    end;

[Rin]

А что подразумевается под термином "совершенное число"?
Согласно Википедии, это натуральное число, равное сумме всех своих собственных делителей.
А вот у меня в курсовой было такое определение "совершенного числа".
Вот оно - число, которое при всех перестановках цифр, является простым.

[Fatalita]

В этом случае то определение, что было в вашей курсовой.

[Rin]

program n_9_14_g;

{$APPTYPE CONSOLE}

uses
  SysUtils;


type 
  pere=array[byte] of byte;//описание типа массива под цифры проверяемого числа

procedure Swap(var a,b:byte);  {обмен переменных}
var c:byte;
begin
     // B:=A ,  A:=B
     c:=a;
     a:=b;
     b:=c;
end;

procedure My_Next(var X:Pere;var Yes:boolean);
  var i,j:byte;
    begin
	  i:=length(s)-1;
	  //поиск i
	  while (i>0) and (X[i]>X[i+1]) do dec(i);
	  if i>0 then
	    begin
	      j:=i+1;
	      //поиск j
	      while (j<length(s)) and (X[j+1]>X[i]) do inc(j);
	      Swap(X[i],X[j]);
        for j:=i+1 to (length(s)+i) div 2 do Swap(X[j],X[length(s)-j+i+1]);
        Yes:=true;
	    end
	  else Yes:=false;
end;

function number_perfect(var np:integer):boolean;
 var
  d: integer; // делитель
  r,q: integer; // остаток от деления n на d
  n,n1:integer;// переменные для компоновки проверяемого числа
  kol:integer;// кол-во перестановок
  i:byte;// переменная под цикл FOR
  x,y:pere;
  Yes:boolean;
  S:string;// сохранение проверяемого числа
begin
     result:=false;
     if np<>1 then
     begin
       d:=2; // сначала будем делить на два
       repeat
         r := np mod d;
         if r<>0 {// n не разделилось нацело на d} then
         d:=d+1;//то прибавим к делителю 1
       until r=0; // повторять пока не найдено число на n делится без остатка
       if d=np then //если d=np,то есть число делится только на себя
       begin
         s:=inttostr(np);//запоминаем это число
         for q:=1 to length(s) do y[q]:=strtoint(s[q]); //вытаскиваем цифры
         kol:=1;
         for i:=1 to length(s) do
         begin
           X[i]:=i;  //задаем количество перестановок
           kol:=kol*i;   //счетчик перестановок для определения сов. числа
         end;
         repeat
           n1:=0;
     	     for i:=1 to length(s) do
           begin
          //воссоздаем число из цифр
             n:=Y[X[i]];
             n:=n+n1;
             if length(s)>1 then
             n1:=10*n;
           end;
           d:=2; // сначала будем делить на два
           repeat
             r:= n mod d;
             if r<>0 {// n не разделилось нацело на d} then
             d:=d+1;
           until r=0; // повторять пока не найдено число на n делится без остатка
           if d=n then kol:=kol-1;//
    	     My_Next(X,Yes)//производим следующую перестановку числа
         until not Yes;//пока не произведены все перестановки над числом,
                         //цикл будет прдолжаться
         if kol=0 then //если все перестановки - простые -
                       //значит число совершенное
         begin
           result:=true;
           exit;
         end;
       end;
     end;
end;

var
    A: array[1..100] of Real;
    max_k,k,n,i: Integer;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  write('n=');
  Readln(n);
  k:=0;
  max_k:=0;
  for i:=1 to n do
    begin
      write('A[',i,']=');
      Readln(A[i]);
      if number_perfect(A[i]) then// если число совершенное, то
      begin
        k:=k+1;// увеличить счетчик текущей последовательности сов.чисел
        if k>max_k then// если счетчик текущей последовательности больше макс.
        // найденной последовательности, то
        max_k:=k;
      end
      else// иначе 
      k:=0;// сбросить в ноль счетчик текущ. последовательности
    end;
  // выводим максим. найденную последовательность
  writeln('maximum sequence perfect number=',max_k);
  readln;
end.

[Fatalita]

Как - то подозрительно много.

А s не обозначена. К какому типу она принадлежит? Давайте я дам вам контрольный пример. А то я что - то не совсем понимаю.

n=8; A={6;28;3;496;28;8128;3;6}
Ожидаемый результат: Наибольшая длина 3.

[Rin]

Этой функцией вы ищите не совершенное число, а простое.

  function Perfect(n:longint):boolean;
  var
  i,s:longint;
begin
  s:=0;
  for i:=1 to n div 2 do
    if n mod i = 0 then
      s:=s+i;
  result:= n=s;
end;

А чтобы найти совершенное, нужно сначала найти простое, потом выполнить N! перестановок, где N-количество цифр в числе, при этом чтобы при каждой перестановке число было опять же простым.
Но если вы не верите, то можете не использовать данный код. Я никого не заставляю.
Кстати, процедура My_Next отвечает за перестановки. Забыл прокомментировать.

Занесите в глобальные переменные s:string; а в функции number_perfect сотрите s:string;
UPD
Так, вы заморочили мне голову.

[Fatalita]

Я вам?) По - моему, вы мне. Сложно как - то все. Я ведь первый курс. У нас никогда не было таких длинных программ.

[Mad_Cat]

Этой функцией как раз и ищется совершенное число согласно вики. Откуда знаю? Я же ее и писал в предыдущем топике на эту тему от нашего ТС.
2ТС ВЫ БЫ определились какое именно число вы подразумеваете под совершенным.

[Fatalita]

Откуда мне знать? Это ведь не я задачу придумала. Я ее из учебника переписала.

[Mad_Cat]

Уточнить у преподавателя вера не позволяет или комплексы какие? У нас скилл телепатии хоть и прокачен но не столько же.