Помощь
попробуй следующий алгоритм:
procedure Find(mas:array of word;m:word);
var
imas,nmas:array of Word;
k,j:word;
i:longint;
max,min:word;
h,s:real;
isk:array of word;
begin
max:=0;
min:=0;
k:=0;
{я попытался максимально
проанализировать алгоритм для массивов с огромным количеством элементов ,получился алгоритм в котором я не до конца уверен }
//Начнем
for i:=0 to High(mas) do //найдем максимум и минимум
begin
if mas[i]>max then
max:=mas[i]
else
if mas[i]<min then
min:=mas[i];
end;
setlength(imas,max-min); //сейсчас поюзаем метод
for i:=0 to max-min do //быстрой сортировки
begin //ее суть подсчитать количество
inc(imas[mas[k]]); //повторяющихся символов в
inc(k); //массиве
end;
j:=0;
for i:=0 to high(imas) do //сортируем
begin
for k:=1 to imas[i] do
begin
mas[i+j]:=i+1;
inc(j);
end;
end;
for i:=0 to high(mas) do
nmas[i]:=mas[i];//приходиться копировать массив
for i:=high(nmas) downto 0 do //удаляем лишнее
if nmas[i]<m then begin
setlength(nmas,i);
break;
end;
{все предидущее для того чтобы удалить лишнее из массива и оптимизировать поиск.
Далее я использую характеристики множеств,то бишь среднее арифметическое значение и количество элементов;если среднее арифметическое значение это
h и i-количество элементов, то они связаны уравнением
m=h*i ,где m-это сумма элементов ,теперь мы просто генерим элементы искомых множеств}
for i:=1 to high(nmas) do begin
h:=m/i;
setlength(isk,i);
while s<>h do begin
s:=0;
k:=0;
while k<>i-1 do begin
Randomize;
isk[k]:=min+random(max-min+1);
if imas[isk[k]]=0 then //проверка на существование
continue; // быстрее чем обычным способом
inc(k);
end;
for k:=0 to i-1 do
s:=s+isk[k]/i;
end;
for j:=0 to high(isk) do
Form1.RichEdit1.Lines.Add(Inttostr(Isk[j]));//здесь по желанию
end;
end;
Вот и все!Удачи!
|