» Utilizator
Salut, vizitatorule!

SkullBox este o comunitate formata din programatori si administratori de sisteme sau retele care iti sta la dispozitie cand ai o problema legata de calculatoare. Daca esti un utilizator existent, autentifica-te.

Daca nu te-ai inregistrat inca pe forum, alatura-te noua astfel marind comunitatea si ajutandu-i pe cei care au nevoie de informatii.

Daca te-ai inregistrat dar inca nu ai primit codul de activare, il poti cere aici.




Autentifica-te cu numele de utilizator si parola pentru a putea posta pe forum sau pentru a accesa ariile disponibile doar utilizatorilor inregistrati.
» Promovam
» Parteneri » Statistici
  • 59749 de mesaje.
  • 7151 de topicuri.
  • 1012 de utilizatori.
  •  
  • Sheergosoke e ultimul utilizator inregistrat.
[Detalii]

 
Pagini: [1]
Print
ordinea lexicografica a permutarilor [1824 afisari]
ciupikus



Mesaje: 1
OfflineOffline


am si eu o problema nu gasesc formula de recurenta pentru aflarea numarului de ordine al permutarii:d, are cineva habar?
de ex: n=5
si permutarea e 45231 care e numarul de ordine...adik ma intereseaza formula.
Logged
21-01-2008, 14:05 Twitt ::
Archangel
*


Mesaje: 1391
OfflineOffline

WWW

numarul de ordine adica a cata permutare este? cu formula nu te pot ajuta, dar o idee ar fi sa faci un program prin metoda backtraking si la fiecare solutie afisata sa pui un contor ...
Logged

Archangel on deviantART | Archangel on Flickr |
"Daca voi nu ma vreti, eu va vreu!"
02-02-2008, 16:45 Twitt ::
free2infiltrate
*


Mesaje: 84
OfflineOffline


Cu backtraking dureaza foarte mult, si pentru numere mari nu e chiar rentabil.
Din cate stiu ai nevoie de numerele lui Stirling de speta I ca sa rezolvi problema.
Logged
14-02-2008, 15:04 Twitt ::
emi
*


Mesaje: 1560
OfflineOffline


Da.

Permutare -> numar de ordine in "ordine" lexicografica:
Code:
const
  n=4;
type
  tv=array[1..n] of 1..n;
const
  v:tv=(4,2,3,1);

function perm(n:byte):longint;
var i:byte;
    p:longint;
begin
  p:=1;
  for i:=1 to n do p:=p*i;
  perm:=p;
end;

function p2n:longint;
var i,j:byte;
    x:longint;
    w:tv;
begin
  w:=v;
  x:=1;
  for i:=1 to n do begin
    x:=x+perm(n-i)*(w[i]-1);
    for j:=i+1 to n do if w[j]>w[i] then dec(w[j]);
  end;
  p2n:=x;
end;

begin
  write(p2n);
  readln;
end.

Numar de ordine al permutarii -> permutare
Code:
const
  n=4;
var
  v:array[1..n] of 1..n;
  x:longint;
  i,j:byte;

function perm(n:byte):longint;
var i:byte;
    p:longint;
begin
  p:=1;
  for i:=1 to n do p:=p*i;
  perm:=p;
end;

procedure n2p;
var i,j,k,t:byte;
    p:longint;
begin
  for i:=1 to n do v[i]:=i;
  for i:=1 to n-1 do
  if x>perm(n-i) then begin
    p:=perm(n-i);
    k:=(x-1) div p;
    x:=1+(x-1) mod p;
    t:=v[i+k];
    for j:=i+k downto i+1 do v[j]:=v[j-1];
    v[i]:=t;
  end;
end;

begin
  write('x='); readln(x);{}
  n2p;
  for i:=1 to n do write(v[i]:3);
  readln;
  end;{}
end.

Si mai am  Big grin

Aranjamente:
A2N.pas
Code:
const
  n=4;
  k=3;
type
  vt=array[1..k] of 1..n;
const
  v:vt=(4,2,3);

function aranj(n,k:byte):longint;
var i:byte;
    x:longint;
begin
  x:=1;
  for i:=n-k+1 to n do x:=x*i;
  aranj:=x;
end;

function a2n:longint;
var i,j:byte;
    x:longint;
    w:vt;
begin
  w:=v; x:=1;
  for i:=1 to k do begin
    x:=x+aranj(n-i,k-i)*(w[i]-1);
    for j:=i+1 to k do if w[j]>w[i] then dec(w[j]);
  end;
  a2n:=x;
end;

begin
  write(a2n);
  readln;
end.

n2a.pas
Code:
const
  n=4;
  k=3;
var
  v:array[1..k] of 1..n;
  x:longint;
  i:byte;

function aranj(n,k:byte):longint;
var i:byte;
    x:longint;
begin
  x:=1;
  for i:=n-k+1 to n do x:=x*i;
  aranj:=x;
end;

procedure n2a;
var i,j,c,p:byte;
    d:array[1..n] of 0..1;
    a:longint;
begin
  for i:=1 to n do d[i]:=1;
  for i:=1 to k do begin
    a:=aranj(n-i,k-i);
    p:=1+(x-1) div a;
    x:=1+(x-1) mod a;
    c:=0;
    for j:=1 to p do repeat inc(c) until d[c]=1;
    d[c]:=0;
    v[i]:=c;
  end;
end;

begin
  write('x='); readln(x);
  n2a;
  for i:=1 to k do write(v[i]:3);
  readln;
end.

Combinari:

c2n.pas
Code:
const
  n=7;
  k=4;
  v:array[1..k] of byte=(3,4,5,7);

function cnk(n,k:byte):longint;
var i,a,b:byte;
    c:longint;
begin
  c:=1; a:=k; b:=a;
  if a>n-a then a:=n-a else b:=n-b;
  for i:=b+1 to n do c:=c*i;
  for i:=2 to a do c:=c div i;
  cnk:=c;
end;

function c2n:longint;
var x:longint;
    i,j:byte;
begin
  x:=1;
  for i:=v[1]-1 downto 1 do x:=x+cnk(n-i,k-1);
  for i:=2 to k do
  for j:=v[i]-1 downto v[i-1]+1 do x:=x+cnk(n-j,k-i);
  c2n:=x;
end;

begin
  write(c2n);
  readln;
end.

n2c.pas
Code:
const
  n=7;
  k=4;
var
  v:array[1..k] of 1..n;
  x:longint;
  i:byte;

function cnk(n,k:byte):longint;
var i,a,b:byte;
    c:longint;
begin
  c:=1; a:=k; b:=a;
  if a>n-a then a:=n-a else b:=n-b;
  for i:=b+1 to n do c:=c*i;
  for i:=2 to a do c:=c div i;
  cnk:=c;
end;

procedure n2c;
var i,j:byte;
begin
  for i:=1 to k do v[i]:=i;
  dec(x);
  for i:=1 to k do
  while x>=cnk(n-v[i],k-i) do begin
    x:=x-cnk(n-v[i],k-i);
    inc(v[i]);
    for j:=i+1 to k do v[j]:=v[j-1]+1;
  end;
end;

begin
  write('x='); readln(x);
  n2c;
  for i:=1 to k do write(v[i]:3);
  readln;
end.
Logged
11-06-2009, 14:10 Twitt ::
Reclama
VIP

Hosting

Mesaje: 25.90
OnlineOnline

WWW
 

   Pe ABCDomenii: 250MB spatiu + 20GB trafic + 5 subdomenii = 0.95 €
 
 

The problem with troubleshooting is that trouble shoots back.
Azi 
Pages: [1]
Print
SkullBox Forum  |  Development  |  Delphi & Pascal  |  Pascal / Delphi Snippets  |  Topic: ordinea lexicografica a permutarilor
Jump to: