fork download
copy 
  1. #!perl
  2.  
  3. use strict;
  4. use warnings;
  5. use bigint;
  6.  
  7. sub nth_permutation($@) {
  8. 	my ($p, @c) = @_;
  9. 	my @repno;
  10. 	my $d = 1;
  11. 	my $fact = 1;
  12. 	my $n = scalar(@c);
  13.  
  14. 	$fact *= $_ for (2..$n);
  15.  
  16.  
  17. 	for( @c ) {
  18. 	    $repno[$_] ++;
  19. 	    $d *= $repno[$_];
  20. 	}
  21.  
  22.   SLOT: for (my $i=0; $i<$n; $i++) {
  23. 	  $fact /= $n - $i;
  24. 	DIGIT: for (my $j=0; $j<scalar(@repno); $j++) {
  25. 	    if ($repno[$j] < 1) { next DIGIT; }
  26. 	    my $p2 = $fact / ($d / $repno[$j]);
  27. 	    if ($p2 > $p) {
  28. 		$d /= $repno[$j];
  29. 		$repno[$j] --;
  30.  
  31. 		$c[$i] = $j;
  32. 		next SLOT;
  33. 	    }
  34. 	    $p -= $p2;
  35. 	}
  36.   }	
  37.  
  38. 	return @c;
  39. }
  40.  
  41. sub permno(@) {
  42.     my (@choices) = @_;
  43.     my $n = @choices;
  44.  
  45.     # for now assume symbols are 0-based integers
  46.     # with no gaps
  47.  
  48.     my @repno = map {0} (0..$n-1);  # number of times each symbol is repeated
  49.  
  50.     my $p = 0;
  51.     my $d = 1;
  52.  
  53.     my $fact = 1;
  54.  
  55.     for (my $i = $n -1; $i >= 0; $i--) {
  56.         my $c = $choices[$i];
  57.  
  58. 	    $repno[$c] ++;
  59. 	    $d *= $repno[$c];
  60.  
  61. 	    for (my $j = 0; $j < $c; $j ++ ) {
  62. 		next unless $repno[$j] > 0;
  63. 		$p += $fact / ( $d /$repno[$j]);
  64. 	    }
  65. 	    $fact *= $n - $i;	
  66.     } 
  67.     return $p;
  68. }
  69.  
  70.  
  71. while (<>) {
  72.     my ($m, @c) = split(/\s*[,]*\s+/);
  73. 	if ($m =~ /^ *pn/) {
  74.         my $p = permno( @c);
  75.         print $p . "\n";
  76. 	}
  77. 	elsif ($m=~ /^ *p/) {
  78. 	    my ($p, @code) = @c;
  79. 	    my @order = nth_permutation($p, @code);
  80. 	    print join (' ', @order) . "\n";
  81. 	}
  82. }
Success #stdin #stdout 0.14s 8656KB
comments ()
stdin
copy 
pn 5 4 3 2 1 0
pn 2 1 0 0
pn 5 0 1 2 5 0 1 2 0 0 1 1 5 4 3 2 1 0
pn 8 8 8 8 8 8 8 8 8 7 7 7 6 5 0 1 2 5 0 1 2 0 0 1 1 5 4 3 2 1 0 6 7 8
p 719, 0 1 2 3 4 5  
p 11, 0 0 1 2
p 10577286119, 0 0 0 0 0 1 1 1 1 1 2 2 2 3 4 5 5 5
p 3269605362042919527837624, 0 0 0 0 0 1 1 1 1 1 2 2 2 3 4 5 5 5 6 6 7 7 7 7 8 8 8 8 8 8 8 8 8 8
stdout
copy 
719
11
10577286119
3269605362042919527837624
5 4 3 2 1 0
2 1 0 0
5 0 1 2 5 0 1 2 0 0 1 1 5 4 3 2 1 0
8 8 8 8 8 8 8 8 8 7 7 7 6 5 0 1 2 5 0 1 2 0 0 1 1 5 4 3 2 1 0 6 7 8
https://ideone.com/PRwvjT
language:
Perl (perl 5.28.1)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!