June 2018 Update

Task/Permutations-Rank-of-a-permutation/Perl/permutations-rank-of-a-permutation.pl

@@ -0,0 +1,20 @@
+use ntheory qw/:all/;
+
+my $n = 3;
+print "    Iterate Lexicographic rank/unrank of $n objects\n";
+for my $k (0 .. factorial($n)-1) {
+  my @perm = numtoperm($n, $k);
+  my $rank = permtonum(\@perm);
+  die unless $rank == $k;
+  printf "%2d --> [@perm] --> %2d\n", $k, $rank;
+}
+print "\n";
+
+print "    Four 12-object random permutations using ranks\n";
+print join(" ", numtoperm(12,urandomm(factorial(12)))), "\n"  for 1..4;
+print "\n";
+print "    Four 12-object random permutations using randperm\n";
+print join(" ", randperm(12)),"\n"  for 1..4;
+print "\n";
+print "    Four 4-object random permutations of 100k objects using randperm\n";
+print join(" ", randperm(100000,4)),"\n"  for 1..4;

Task/Permutations-Rank-of-a-permutation/REXX/permutations-rank-of-a-permutation.rexx

@@ -1,38 +1,35 @@
 /*REXX program displays permutations of   N   number of  objects  (1, 2, 3,  ···).      */
-parse arg N seed .                               /*obtain optional arguments from the CL*/
-if N=='' | N==","  then N=4                      /*Not specified?  Then use the default.*/
+parse arg N y seed .                             /*obtain optional arguments from the CL*/
+if N=='' | N==","  then N= 4                     /*Not specified?  Then use the default.*/
+if y=='' | y==","  then y=17                     /* "      "         "   "   "     "    */
 if datatype(seed,'W')  then call random ,,seed   /*can make RANDOM numbers repeatable.  */
-permutes=permSets(N)                             /*returns  N! (number of permutations).*/
-w=length(permutes)                               /*used for aligning the  SAY  output.  */
-
-      do what=0  to permutes-1                   /*traipse through each of the permutes.*/
-      z=permSets(N, what)                        /*get which of the  permutation  it is.*/
-      say N 'items, permute' right(what,w)   "="   z  '  rank=' permSets(N,,z)
-      end   /*what*/
-say
-N=12
-      do 4;     ?=random(0, N**4)                /*REXX has a  100k  RANDOM range.      */
-      say  N   'items, permute'    right(?,6)     " is "     permSets(N,?)
-      end   /*rand*/
+permutes= permSets(N)                            /*returns  N! (number of permutations).*/
+w= length(permutes)                              /*used for aligning the  SAY  output.  */
+@.=
+      do p=0  to permutes-1                      /*traipse through each of the permutes.*/
+      z=permSets(N, p)                           /*get which of the  permutation  it is.*/
+      say 'for'     N     "items, permute rank"      right(p,w)        'is: '        z
+      @.p=z                                      /*define a rank permutation in @ array.*/
+      end   /*p*/
+say                                              /* [↓]  displays a particular perm rank*/
+say '  the permutation rank of'  y  "is: "   @.y /*display a particular permuation rank.*/
 exit                                             /*stick a fork in it,  we're all done. */
 /*──────────────────────────────────────────────────────────────────────────────────────*/
-permSets: procedure expose @. #;    #=0;    parse arg x,r,c;     c=space(c);      xm=x-1
-
-                  do j=1  for x;    @.j=j-1;   end /*j*/
-          _=0;    do u=2  for xm;   _=_ @.u;   end /*u*/
-          if r==#  then return _;           if c==_  then return #
-
-                  do  while .permSets(x,0); #=#+1; _=@.1
-                     do v=2  for xm;   _=_  @.v;   end /*v*/
-                  if r==#  then return _;   if c==_  then return #
-                  end   /*while···*/
-          return #+1
+permSets:   procedure expose @. #;     #=0;    parse arg x,r,c;   c=space(c);      xm=x -1
+                    do j=1  for x;     @.j=j-1;   end  /*j*/
+            _=0;    do u=2  for xm;    _=_ @.u;   end  /*u*/
+            if r==#  then return _;            if c==_  then return #
+                    do  while .permSets(x,0);  #=#+1;  _=@.1
+                       do v=2  for xm;    _=_  @.v;    end  /*v*/
+                    if r==#  then return  _;   if c==_  then return #
+                    end   /*while···*/
+            return #+1
 /*──────────────────────────────────────────────────────────────────────────────────────*/
 .permSets:  procedure expose @.;       parse arg p,q;    pm=p-1
                   do k=pm  by -1  for pm;   kp=k+1;  if @.k<@.kp  then do; q=k; leave; end
                   end   /*k*/
 
-                  do j=q+1  while j<p;   parse  value  @.j  @.p   with   @.p  @.j;   p=p-1
+                  do j=q+1  while j<p;  parse  value  @.j  @.p   with   @.p  @.j;   p=p -1
                   end   /*j*/
             if q==0  then return 0
                   do p=q+1  while @.p<@.q;   end  /*p*/

Task/Permutations-Rank-of-a-permutation/Ring/permutations-rank-of-a-permutation.ring

@@ -0,0 +1,44 @@
+# Project : Permutations/Rank of a permutation
+# Date    : 2017/10/21
+# Author : Gal Zsolt (~ CalmoSoft ~)
+# Email   : <calmosoft@gmail.com>
+
+list = [0, 1, 2, 3]
+for perm = 0 to 23
+    str = ""
+    for i = 1 to len(list)
+        str = str + list[i] + ", "
+    next
+    see nl
+    str = left(str, len(str)-2)
+    see "(" + str + ") -> " + perm
+    nextPermutation(list)
+next
+
+func nextPermutation(a)
+     elementcount = len(a)
+     if elementcount < 1 then return ok
+     pos = elementcount-1
+     while a[pos] >= a[pos+1]
+           pos -= 1
+           if pos <= 0 permutationReverse(a, 1, elementcount)
+              return
+           ok
+     end
+     last = elementcount
+     while a[last] <= a[pos]
+           last -= 1
+     end
+     temp = a[pos]
+     a[pos] = a[last]
+     a[last] = temp
+     permutationReverse(a, pos+1, elementcount)
+
+ func permutationReverse(a, first, last)
+      while first < last
+            temp = a[first]
+            a[first] = a[last]
+            a[last] = temp
+            first = first + 1
+            last = last - 1
+      end