freepascal.ru

Код: Выделить всё

program project1;

{$mode objfpc}{$H+}

const
  MAX = 10;

type
  PMassiv = ^TMassiv;
  TMassiv = record
    a     : Integer;
    prev  : PMassiv;
    next  : PMassiv;
  end;
   
  TDynamicMassiv = array of TMassiv;
  
  { TDynamicMassivObject }

  TDynamicMassivObject = class(TObject)
    d   : TDynamicMassiv;
    procedure SetSize;
    procedure AddItem(a: Integer; N: Integer);
  end;

var
  gl : Integer = 0;  
  global :  TDynamicMassivObject;
const
  THIRD_NUMBER = 9;
  
function getRandom: Integer;
var
  k : Integer;
begin
  k:=6;
  case gl of
    0: getRandom:=10;
    1: Result:=6;
    2: getRandom:=4;
    3: Result:= THIRD_NUMBER;
    4: getRandom:=7;
    6: getRandom:=1;
    7: Result:= 12;
    8: getRandom:=2;
    9: Result:= 3;
  else
    if gl=5 then Result:=k
    else Result:=random(10);
  end;
  inc(gl);
end;
  
{ TDynamicMassivObject }

procedure TDynamicMassivObject.SetSize; 
begin
  global:=Self;
  SetLength(global.d, MAX);
end;

procedure TDynamicMassivObject.AddItem(a: Integer; N: Integer); 
begin
  N:=N-1;
  d[N].a:=a;
  if N<MAX-1 then d[N].next:=@d[N+1]
  else d[N].next:=PMassiv(0);
  if N>0 then d[N].prev:=@d[N-1]
  else d[N].prev:=PMassiv(0);
end;
  
procedure ZapolnitMassiv;
var
  i : Integer;
  o: TDynamicMassivObject;
begin
  o:=TDynamicMassivObject.Create;
  o.SetSize;
  for i:=1 to MAX do
    o.AddItem(getRandom, i);
end;

function GetIndex(p: PMassiv): Integer;
var
  i : Integer;
begin
  for i:=0 to length(global.d)-1 do
    if @global.d[i]=p then begin
      Result:=i;
      Exit;
    end;
  Result:=-1;
end;

procedure FindMenshe(A: integer);
var
  w : array [0..65535] of Boolean;
  i : Integer;
  p : PMassiv;
begin
  for i:=0 to 65535 do w[i]:=False;
  p:=@global.d[0];  
  
  while p<>nil do begin
    if p^.a<A then  
      w[p^.a]:=True;
    i:=GetIndex(p);
    if i<0 then begin
      if p^.Next=nil then 
        p:=p^.Next;
    end else  begin
      inc(i);
      p:=@global.d[i];
    end;
  end;    
  
  for i:=0 to 65535 do 
    if w[i] then write(i,' ');
  writeln;
end;

procedure Print;
var
  i : Integer;
begin
  for i:=0 to length(global.d)-1 do
    write(global.d[i].a,' ');
  writeln;
end;

var 
  a : Integer;
begin
  ZapolnitMassiv;
  Print;
  writeln('vvedite chislo A:');
  readln(a);
  FindMenshe(a);
end.

Код: Выделить всё

type
  TDynamicIntegerArray=array of integer;
var
  SourceArray,SearchBuffer:TDynamicIntegerArray;
  A,LLength,LSize,I,J,K:integer;
...
begin
...
   // Здесь в SourceArray нужно поместить исходный массив
   // А в А - граничное число
...
  LLength:=Length(SourceArray);
  SetLength(SearchBuffer,LLength); // для быстроты выделяем под буферный массив столько же места, сколько под основной
  LSize:=0; // в этой переменной будет реальное количество данных в буферном массиве
  for I:=0 to LLength-1 do begin // пройдемся по всем элементам исходного массива    
    K:=SourceArray[I];
    if (K<A) then begin
      J:=0;
      while (J<LSize) do begin // просмотрим все внесенные данные буферного массива
         if (K=SearchBuffer[J]) then begin
           J:=LSize+1; // гарантированный выход+1. J=LSize используется для индикации, что ни одного совпадения не было найдено
         end else begin
            inc(J);
         end;      
         if (J=LSize) then begin // счетчик открутился до конца, ни одного совпадения не найдено
           SearchBuffer[LSize]:=K;
           inc(LSize);
         end;  
      end;
    end;
  end;
  MessageDlg('Ваш ответ ='+IntToStr(LSize));