| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Простая математическая задача [D6]

mixvictor ©   (2003-01-07 17:57:00) 

Необходимо найти все перестановки заданного вектора.
Например дан вектор (1,2,3,4). Перестановки: (1,2,3,4); (2,3,4,1); (1,2,4,3) и тд. Всего 24 штуки. Необходимо сделать для вектора любо длины. Знаю что количество перестановок считается по формуле N!, где N - число чисел в векторе.

---

Sha   (2003-01-08 17:52:00) [1]

Простое математическое решение:

procedure NextPermutation(const s: string);
var
c1, c2, c3, c4: char;
i, j, k: integer;
p: pchar;
f: boolean;
begin;
i:=length(s); if i<=1 then exit;
j:=i; p:=pointer(s); c1:=(p+i-1)^;
repeat;
dec(i); c2:=c1; c1:=(p+i-1)^;
if c1<c2 then begin;
k:=i+1; f:=true;
while k<=j do begin;
c4:=(p+j-1)^;
if f and (c4>c1) then begin; (p+i-1)^:=c4; c4:=c1; f:=false; end;
(p+k-1)^:=c4;
if k=j then break;
c3:=c2; c2:=(p+k)^;
if f and (c2<c1) then begin; (p+i-1)^:=c3; c3:=c1; f:=false; end;
(p+j-1)^:=c3;
inc(k); dec(j);
end;
break;
end;
until i<=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
len= 6;
var
s, t: string;
i: integer;
p: pchar;
begin;
SetLength(s,len); p:=pchar(s); for i:=1 to len do (p+i-1)^:=chr(ord("0")+i);
SetLength(t,len); p:=pchar(t); for i:=1 to len do (p+len-i)^:=chr(ord("0")+i);

Memo1.Lines.BeginUpdate;
Memo1.Lines.Clear;
Memo1.Lines.Add(s); i:=1;
while s<>t do begin;
NextPerMutation(s); Memo1.Lines.Add(s); inc(i);
end;
Memo1.Lines.EndUpdate;
Label1.Caption:=IntToStr(i);
end;

---

}{enon   (2003-01-07 19:00:00) [2]

procedure main;
const n=4;
var
i: integer; "счётчик
v: array[1..n] of integer; "твой вектор
st: array[1..n] of integer; "стек
l: integer; "длина стека
begin
for i:=1 to n do n[i]:=i;
l:=0;
perebor(v, n);
end;

procedure perebor(cv: array of integer, cl: integer;);
var
j: integer;
ccv: array of integer;
begin
for i:=0 to cl-1 do
begin
l:=l+1;
st[l]:=cv[i];
if l=n then Делай со st то, что нужно; l:=0; else
begin
setlenght(ccv,cl-1); "Не помню, как пользоваться setlenght
for j:=0 to cl-1 do
begin
if j<i then ccv[j]:=cv[j];
if j>i then ccv[j]:=cv[j-1];
end;
perebor(ccv,cl-1);
l:=l-1;
end;
end;
end;

Вроде бы всё, иначе - пиши. А вообще, олимпиадами нужно интересоваться - стандартные олимпиадные алгоритмы часто бывают полезными.

---

Big_Rom   (2003-01-07 18:46:00) [3]

а еще есть такой предмет линейная алгебра и еще один аналитическая геометрия там @ зарыта.

---

mixvictor   (2003-01-07 18:34:00) [4]

Нельзя ли кодик пожалуйста!!!

---

}{enon   (2003-01-07 18:23:00) [5]

Не знаю причём тут вектор, но все задачи вида "найти все перестановки" чераются бэктрэкингом (переборм с возвратом).

---

mixvictor   (2003-01-07 18:07:00) [6]

Необходимо программнонайти все перестановки данного вектора.

---

ghg   (2003-01-07 18:01:00) [7]

А вопрос то в чем? Что-то я недопонял.

С наилучшими ...

---

Наверх