Return to permute.p CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / pascal / tstpx / src

Annotation of 43BSDReno/pgrm/pascal/tstpx/src/permute.p, revision 1.1.1.1

1.1       root        1: program perm(input,output);
                      2: const n=4; nfact=24; {make a table of permutations of 1..4}
                      3: type row=array[1..n] of 1..n;
                      4: var table:array[1..nfact] of row; i,j:integer;
                      5: 
                      6: {Generation of permutations in lexicographic order,
                      7: adapted from CACM Algorithm 202 (Mok-Kong Shen)}
                      8: procedure perle (var s:row); {s is a row consisting of the nth permutation,
                      9:                             and will be changed to contain the n+1 st}
                     10: label 1;
                     11: var j,u,w:integer;
                     12: begin
                     13:        w:=n; {permuting integers 1..n}
                     14:        while s[w]<s[w-1] do w:=w-1;
                     15:        u:=s[w-1];
                     16:        for j:= n downto w do
                     17:        begin
                     18:                if s[j]>u then begin s[w-1]:=s[j];
                     19:                                     s[j]:=u;
                     20:                                     goto 1
                     21:                               end
                     22:        end;
                     23: 1:     for j:=0 to round((n-w-1)/2 +0.1) do
                     24:          begin u:= s[n-j];
                     25:                s[n-j]:=s[w+j];
                     26:                s[w+j]:= u
                     27:          end
                     28: end; {of perle}
                     29: begin {main program}
                     30: for i:=1 to n do table[1][i]:=i; {initialize first row}
                     31: for i:=2 to nfact do begin
                     32:        table[i]:=table[i-1] {copy row};
                     33:        perle(table[i])
                     34:        end;
                     35: for i:=1 to nfact do begin for j:=1 to n do write(table[i][j]); writeln end;
                     36: end.
                     37:        
                     38: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.