C:\test>type 826456.pl #! perl -slw use strict; use Time::HiRes qw[ time ]; use List::Util qw[ min ]; use Data::Dump qw[ pp ]; srand 1; our $N //= 4000; my $start = time(); my %pvalues = map{ $_ => rand() } 1 .. $N; #my %pvalues = ( # 1=> 0.5453980, # 2=> 0.4902384, # 3=> 0.8167950, # 4=> 0.2821822, # 5=> 0.4693030, # 6=> 0.6491767, # 7=> 0.9802138, # 8=> 0.1155778, # 9=> 0.9585124, # 10=> 0.4069490 #); my @orderedKeys = sort { $pvalues{ $b } <=> $pvalues{ $a } } keys %pvalues; my $d = my $n = values %pvalues; $pvalues{ $_ } *= $n / $d-- for @orderedKeys; $pvalues{ $orderedKeys[ $_ ] } = min( @pvalues{ @orderedKeys[ 0 .. $_ ] } ) for 1 .. $n-1; $pvalues{ $_ } = min( $pvalues{ $_ }, 1 ) for keys %pvalues; printf "$N: Took %.3f seconds\n", time() - $start; #pp \%pvalues; C:\test>type 826456-a.pl #! perl -slw use strict; use autobox::Core; use Time::HiRes qw[ time ]; use List::Util qw[ min ]; use Data::Dump qw[ pp ]; srand 1; our $N //= 4000; my $start = time(); my %pvalues = @{ [ 1 .. $N ]->map( sub{ $_[0] => rand() } ) }; #my %pvalues = ( # 1=> 0.5453980, # 2=> 0.4902384, # 3=> 0.8167950, # 4=> 0.2821822, # 5=> 0.4693030, # 6=> 0.6491767, # 7=> 0.9802138, # 8=> 0.1155778, # 9=> 0.9585124, # 10=> 0.4069490 #); my @orderedKeys = @{ %pvalues->keys->sort( sub{ $pvalues{ $_[1] } <=> $pvalues{ $_[0] } } ) }; my $d = my $n = @{ %pvalues->keys }; @orderedKeys->map( sub{ $pvalues{ $_[0] } *= $n / $d--; } ); [ 1 .. $n-1 ]->map( sub{ $pvalues{ $orderedKeys[ $_[0] ] } = min( @pvalues{ @orderedKeys[ 0 .. $_[0] ] } ); } ); %pvalues->keys->map( sub{ $pvalues{ $_[0] } = min( $pvalues{ $_[0] }, 1 ) } ); printf "$N: Took %.3f seconds\n", time() - $start; #pp \%pvalues; __END__ C:\test>826456 -N=4000 4000: Took 1.367 seconds C:\test>826456-a -N=400 400: Took 0.025 seconds C:\test>826456-a -N=800 800: Took 0.988 seconds C:\test>826456-a -N=1600 1600: Took 13.999 seconds C:\test>826456-a -N=3200 3200: Took 119.228 seconds C:\test>826456-a -N=4000 4000: Took 234.037 seconds