FELADAT:

Írjunk egy olyan eljárást, melynek argumentumába egy N pozitív egész számot, vagy egy listát megadva egy olyan eljárást kapunk vissza, amely minden meghívásakor az N szám vagy a lista elemeinek egy újabb permutációját adja.

> restart;

Először megírjuk a KNUTH-könyvben (http://www-cs-faculty.stanford.edu/~knuth/news.html) szereplő algoritmust. Csak két dolgon változtatunk:

1. a legvégén szereplő goto 1 helyett a programrészlet elejére egy do, végére egy end do parancsot írunk;

2. a könyvben szerplő algoritmus azt feltételezi, hogy az 'a' vektor 'a[0]' eleme határozottan kisebb 'a' legnagyobb eleménél. Ezt nehéz teljesíteni, ha minden elem egyforma, és nem kötjük, hogy a lista elemei csak számok lehetnek, ezért beszúrtunk egy vizsgálatot, mely megadkadályozza, hogy az 'a[0]' elemet összehasonlítsuk bármivel is, vagyis 'a' indexe így csak 1-től fut n-ig.

Itt követhetjük KNUTH algoritmusát is, ha pl. kikötjük, hogy ha az algoritmus listaként van megadva, akkor az csak számok listája lehet, és ekkor kiadjuk pl. a

utasítást az inicializációs részben.

A programban megjegyzésként szerepelnek KNUTH sorszámai is:

> perms := proc(N::{integer,list})

> local a, j, k, l, n;

>

> if type(args,integer) then n:=N; a:=array([$1..n])

> elif type(args,list) then n:=nops(N); a:=array(N)

> else error "wrong type of args"

> end if;

>

> do

> #1:

> print(a);

> #2:

> j:=n-1;

> while j>0 and a[j] >= a[j+1] do

> j:=j-1;

> od;

> if j=0 then break end if;

> #3:

> l:=n;

> while a[j] >= a[l] do

> l:=l-1

> od;

> (a[j],a[l]) := (a[l],a[j]);

> #4:

> k:=j+1; l:=n;

> while k<l do

> (a[k],a[l]) := (a[l],a[k]);

> k:=k+1;

> l:=l-1;

> od;

> od;

>

> print("vége");

>

> end proc:

> perms(3);

> perms([1,2,2]);

>

A következő lépésben minimális változtatást végzünk e kódon, hogy beilleszthessük perms-et egy olyan perm nevű eljárásba, mely egy olyan függvényt ad vissza, mely minden meghívásakor csak egyetlen permutációt ad vissza:

1. A j változót mindig FAIL-re állítjuk, ha előlről kezdődik a felsorolás;

2. Az 1-es pontot, vagyis a kiíratást az elejéről a végére tesszük, és beszúrunk az elejére egy olyan inicializáló utasítást, mely a legelső nyomtatást is elvégzi.

> perm := proc(N::{integer,list})

> local perms, a, j, k, l, n;

>

> j:=FAIL;

>

> perms := proc()

>

> if j=FAIL then

> if type(N,integer) then n := N; a := array([$1..n])

> else a := array(N); n := nops(N)

> end if;

> print(a); j:=0; return NULL

> end if;

>

> #2:

> j:=n-1;

> while j>0 and a[j] >= a[j+1] do

> j:=j-1;

> od;

> if j=0 then

> j:=FAIL; return j

> end if;

>

> #3:

> l:=n;

> while a[j] >= a[l] do

> l:=l-1

> od;

> (a[j],a[l]) := (a[l],a[j]);

> #4:

> k:=j+1; l:=n;

> while k<l do

> (a[k],a[l]) := (a[l],a[k]);

> k:=k+1:

> l:=l-1:

> od:

>

> #1:

> return evalm(a);

>

> end proc;

>

> proc()

> perms()

> end proc;

>

> end proc;

> f:=perm([1,2,2]);

> to 6 do f() end do;

> f();

> f:=perm(4);

> to 25 do f() end do;

> f();

>