type
  TNumbers= array of integer;

function MaxSet(Numbers: TNumbers): TNumbers;
type
  TElement= record
    Number, Count, Total: integer;
    end;
var
  Matrix: array[0..31, 0..31] of TElement;
  i, j, k, n, t2, t3: integer;
begin;
  for j:=0 to High(Matrix) do for k:=0 to High(Matrix[0]) do Matrix[j,k].Count:=0;
  for i:=0 to Length(Numbers)-1 do begin;
    n:=Numbers[i];
    j:=0;
    while n and 1=0 do begin;
      n:=n shr 1; inc(j);
      end;
    k:=0;
    while n<>1 do begin;
      n:=n div 3; inc(k);
      end;
    inc(Matrix[j,k].Count);
    Matrix[j,k].Number:=Numbers[i];
    end;
  Matrix[0,0].Total:=Matrix[0,0].Count;
  for j:=1 to High(Matrix) do Matrix[j,0].Total:=Matrix[j-1,0].Total + Matrix[j,0].Count;
  for k:=1 to High(Matrix[0]) do Matrix[0,k].Total:=Matrix[0,k-1].Total + Matrix[0,k].Count;
  for j:=1 to High(Matrix) do for k:=1 to High(Matrix[0]) do begin;
    t2:=Matrix[j-1,k].Total + Matrix[j,k].Count;
    t3:=Matrix[j,k-1].Total + Matrix[j,k].Count;
    if t3<t2 then t3:=t2;
    Matrix[j,k].Total:=t3;
    end;
  j:=High(Matrix);
  k:=High(Matrix[0]);
  i:=Matrix[j,k].Total;
  SetLength(Result,i);
  while i<>0 do begin;
    n:=Matrix[j,k].Count;
    while n>0 do begin;
      dec(n); dec(i); Result[i]:=Matrix[j,k].Number;
      end;
    if (j>0) and (Matrix[j-1,k].Total=i) then dec(j) else dec(k);
    end;
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Numbers, Numbers2: TNumbers;
  i, j, n: integer;
begin;
  Randomize;
  Memo1.Lines.Clear;
  Memo2.Lines.Clear;
  n:=StrToIntDef(Edit1.Text,0);
  if n<=0 then exit;
  SetLength(Numbers,n);
  Memo1.Lines.Add(IntToStr(Length(Numbers))+' сгенерировано:');
  for i:=0 to Length(Numbers)-1 do begin;
    n:=1;
    for j:=0 to Random(8)-1 do n:=n*(2+Random(2));
    Numbers[i]:=n;
    Memo1.Lines.Add(IntToStr(n));
    end;
  Numbers2:=MaxSet(Numbers);
  Memo2.Lines.Add(IntToStr(Length(Numbers2))+' осталось:');
  for i:=0 to Length(Numbers2)-1 do Memo2.Lines.Add(IntToStr(Numbers2[i]));
  end;