Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > перебор динамического массива

Автор: stalkerok 18.1.2009, 00:37

Добрый день!
Возможно ли сделать полный перебор значений динамического массива?

например 3-и значения:

Код


var
  i1, i2, i3: integer;
  a: array of integer;
begin
  setlength(a, 3);

  a[0]:=3;
  a[1]:=7;
  a[2]:=5;

  for i1 := 0 to High(a) do
  begin
    for i2 := 0 to High(a) do
    begin
      for i3 := 0 to High(a) do
      begin
        if (not(a[i1]=a[i2]) and not(a[i1]=a[i3]) and not(a[i2]=a[i3])) then
        memo1.Lines.Add(format('%d %d %d',[a[i1], a[i2], a[i3]]));
      end;
    end;
  end;

но как быть если размер массива меняется ? делать как-то динамические циклы и условия?

заранее спасибо!

Автор: Alexeis 18.1.2009, 00:41

Цитата(stalkerok @ 17.1.2009, 23:37

)

но как быть если размер массива меняется ?

внутри цикла? Тогда цикл for не подходит, нужен while

Автор: SneG0K 18.1.2009, 00:43

Цитата(stalkerok @ 17.1.2009, 23:37

)

делать как-то динамические циклы и условия?

Код


 for i:=0 to length(dynamic_array) do
 begin
   ..Запустися цикл по массиву
 end;

Добавлено через 38 секунд

Цитата(Alexeis @ 17.1.2009, 23:41

)

внутри цикла?

Да уточни... А то я сразу не догнал,..

Автор: stalkerok 18.1.2009, 00:44

Цитата

внутри цикла? Тогда цикл for не подходит, нужен while

Нет массив меняется перед циклом, а while получается также писать нужно n раз (n - длина массива)

Автор: Alexeis 18.1.2009, 00:44

SneG0K, а собсно чем length лучше High ? ИМХО это тоже самое +1 элемент.

Добавлено через 1 минуту и 51 секунду

Цитата(stalkerok @ 17.1.2009, 23:44

)

А можно не внутри сделать? а while получается также писать нужно n раз (n - длина массива)

Так это как вам удобно, по идее High должен работать и с динамическими размерностями

Автор: stalkerok 18.1.2009, 00:48

это будет функция в которую будет передаваться массив разной дины например с 500 или 1000 элементов, и тогда как?

Автор: Alexeis 18.1.2009, 00:49

stalkerok, ааа я понял, вложенностей должно быть столько сколько элементов. Попробуйте рекурсию.

Автор: stalkerok 18.1.2009, 00:52

Alexeis спасибо Вам, а как её применить?

Автор: SneG0K 18.1.2009, 01:03

stalkerok, рекурсия - это когда функция вызывает сама себя

Автор: Alexeis 18.1.2009, 01:05

Внутри цикла функция вызовет саму себя, соответственно в ней тоже будет обход цикла с вызовом самой себя. Ток чета мне кажется сам алгоритм требует доработки. В чем состоит задача?

Автор: stalkerok 18.1.2009, 01:21

Цитата

В чем состоит задача?

http://forum.vingrad.ru/forum/topic-243764.html

и вот тут я запутался...

Код


procedure TmainFrm.startClick(Sender: TObject);
var
  i: integer;
  a: array of integer;
begin
  setlength(a, 3);

  a[0]:=3;
  a[1]:=7;
  a[2]:=5;

  memo.Lines.Clear;

  for i := 0 to High(a) do
  begin
    rec(a);
    //memo.Lines.Add(format('%d %d %d',[a[i1], a[i2], a[i3]]));
  end;

end;

function rec(a: array of integer): array of integer;
var
  i:integer;
  b:array of integer;
begin
  setlength(b, length(a));
  for i := 0 to High(a) do
  begin
    //
  end;
end;

Автор: Alexeis 18.1.2009, 01:31

Гм... муторное условие. Что-то похожее решение задачи из теории графов.

Добавлено через 1 минуту и 19 секунд
Одно ясно точно без рекурсии не обойтись, но по примерам трудно понять хорошо бы четкое условие.

Автор: stalkerok 18.1.2009, 15:57

http://algolist.manual.ru/maths/combinat/sequential.php нашёл несколько алгоритмов перебора, не подскажите какой быстрее(лучше)?

Автор: stalkerok 18.1.2009, 19:08

Цитата

Гм... муторное условие. Что-то похожее решение задачи из теории графов.

да так и есть,

Цитата

Одно ясно точно без рекурсии не обойтись, но по примерам трудно понять хорошо бы четкое условие.

мне всего лишь нужно перебрать все комбинации в массиве разной длины (как в старттопике), не получается с рекурсией можно пример?

заранее спасибо!

Автор: stalkerok 18.1.2009, 22:18

Попытался сделать но ничего не получается что не так?

Код


procedure TmainFrm.startClick(Sender: TObject);
var
  a: array of integer;
begin
  setlength(a, 3);
  a[0]:=3;
  a[1]:=7;
  a[2]:=5;
  memo.Lines.Clear;
  rec(a);
end;

procedure TmainFrm.rec(a: array of integer);
var
 i:integer;
begin
  for i := 0 to length(a) do
  begin
    rec(a);
    memo.Lines.Add(format('%d %d %d',[a[i], a[i], a[i]]));
  end;
end;

Автор: stalkerok 19.1.2009, 19:28

http://www.swissdelphicenter.ch/torry/showcode.php?id=1032 то что нужно! помогите переделать под массив и числа.
заранее спасибо!

Код


program Permute;
{$APPTYPE CONSOLE}

uses SysUtils;

var
  R, Slen: Integer;

procedure P(var A: string; B: string);
var
  J: Word;
  C, D: string;
begin
  { P(N,N) >>  R=Slen  }
  if Length(B) = SLen - R then
  begin
    Write(' {' + A + '} '); {Per++}
  end
  else
    for J := 1 to Length(B) do
    begin
      C := B;
      D := A + C[J];
      Delete(C, J, 1);
      P(D, C);
    end;
end;

var
  Q, S, S2: string;
begin
  S  := ' ';
  S2 := ' ';
  while (S <> '') and (S2 <> '') do
  begin
    Writeln('');
    Writeln('');
    Write('P(N,R)  N=? : ');
    ReadLn(S);
    SLen := Length(S);
    Write('P(N,R)  R=? : ');
    ReadLn(S2);
    if s2 <> '' then R := StrToInt(S2);
    Writeln('');
    Q := '';
    P(Q, S);
  end;
end.

Автор: stalkerok 19.1.2009, 20:07

переделал, правильно?

почему с Word не работало а с integer всё нормально стало (i, j: integer;)?

Код


program bust;
{$APPTYPE CONSOLE}

uses
  SysUtils;

procedure Permute(var a: string; b: array of integer);
var
  i, j: integer;
  str: string;
  c: array of integer;
begin
  if length(b) = 0 then
  begin
    write(' ' + a);
    writeln('');
  end
  else
  begin
    for i := 0 to high(b) do
    begin
      //c = b
      setlength(c, length(b));
      for j := 0 to high(b) do c[j]:=b[j];
      str:= a + inttostr(c[i]);
      //Delete
      for j:=i to high(c)-1 do c[j]:=c[j+1];
      SetLength(c, high(c));
      //Permute
      Permute(str, c);
    end;
  end;
end;

var
  arr: array of integer;
  s1: string;
begin
  s1:= '';
  setlength(arr, 3);
  arr[0]:=5;
  arr[1]:=7;
  arr[2]:=3;

  writeln('');
  Permute(s1, arr);
  readLn;
end.