use strict; use warnings; use feature 'say'; use PDL; use File::Map; # ensure that Perl has File::Map before loading FastRaw use PDL::IO::FastRaw; use MCE::Signal '$tmp_dir'; use MCE::Flow; { no warnings 'once'; $PDL::BIGPDL = 1; eval q{ PDL::set_autopthread_targ(1) }; } use List::Util; BEGIN { *_min = \&List::Util::min; # collision *_max = \&List::Util::max } # with PDL use constant MAX => shift || 1e7; use constant TOP => _min( 20, MAX ); use constant CHUNK => _min( 40000, MAX ); # but keep it even use constant MAXLEN => MAX * 1; # ?? # x(1..2) use Time::HiRes 'time'; # create a raw file for lengths writefraw( ones( short, 3 + MAXLEN ), "$tmp_dir/lengths" ); my $max_workers = $^O eq 'MSWin32' ? 8 : MCE::Util::get_ncpu(); my $t = time; my $lengths; MCE::Flow->init( max_workers => _min( $max_workers, MCE::Util::get_ncpu() ), chunk_size => CHUNK + 1, bounds_only => 1, init_relay => 1, user_begin => sub { $lengths = mapfraw( "$tmp_dir/lengths" ); if ( MCE->wid == 1 ) { $lengths-> inplace-> setvaltobad( 1 ); $lengths-> set( 1, 1 ); $lengths-> set( 2, 2 ); $lengths-> set( 4, 3 ); } MCE->sync; }, ); mce_flow_s sub { my ( $mce, $chunk_ref, $chunk_id ) = @_; my ( $from, $to ) = @{ $chunk_ref }; my $seqs_c = $from + sequence( longlong, $to - $from + 1 ); if ( $chunk_id == 1 ) { $seqs_c-> setbadat( 0 ); $seqs_c-> setbadat( 1 ); $seqs_c-> badvalue( 2 ); } else { $seqs_c-> setbadat( $from % 2 ? 1 : 0 ); $seqs_c-> slice([ $from % 2 ? 1 : 0, $to - $from, 2 ]) .= 2; $seqs_c-> badvalue( 2 ); } my $lengths_c = $lengths-> slice([ $from, $to ]); my $current = zeroes( short, nelem( $seqs_c )); while ( any $seqs_c-> isgood ) { my ( $seqs_c_odd, $current_odd_masked ) = where( $seqs_c, $current, $seqs_c & 1 ); $current_odd_masked ++; $current ++; ( $seqs_c_odd *= 3 ) ++; $seqs_c >>= 1; my ( $seqs_cap, $lengths_cap, $current_cap ) = where( $seqs_c, $lengths_c, $current, $seqs_c <= MAXLEN ); my $lut = $lengths-> index( $seqs_cap ); # "_f" is for "finished" my ( $seqs_f, $lengths_f, $lut_f, $current_f ) = where( $seqs_cap, $lengths_cap, $lut, $current_cap, $lut-> isgood ); $lengths_f .= $lut_f + $current_f; $seqs_f .= 2; # i.e. BAD } # "_e" is for "at even positions, ahead" ## ## # my $from_e = _max( $from * 2, $to ) + 2; # bug ## my $from_e = $from == 0 ? $to + 2 : $from * 2; # fixed ## my $to_e = _min( $to * 2, MAXLEN ); ## ## MCE::relay { ## ( $lengths-> slice([ $from_e, $to_e, 2 ]) ## .= $lengths-> slice([ $from_e / 2, $to_e / 2 ])) ++ ## if $from_e <= MAXLEN; ## }; ## }, 0, MAX; MCE::Flow->finish; say {*STDERR} "compute time: ", time - $t; # same finale $lengths = mapfraw( "$tmp_dir/lengths" ); $lengths-> badflag( 0 ); $lengths = $lengths-> slice([ 1, MAX ]); my $sorted_i = $lengths-> qsorti; my $sorted = $lengths-> index( $sorted_i ); my $value = $sorted-> at( MAX - TOP ); my $pos = vsearch_insert_leftmost( $value, $sorted ); my $top_i = $sorted_i-> slice([ MAX - 1, $pos ]); ( my $result = $lengths -> index( $top_i ) -> longlong -> bitnot -> cat( $top_i + 1 ) -> transpose -> qsortvec -> slice([], [ 0, TOP - 1 ]) )-> slice([ 0 ], []) -> inplace -> bitnot; say $result; say {*STDERR} "total time: ", time - $t;