#! perl -slw use strict; use threads; use threads::shared; use threads::Q; ## Self-limiting sized queues. use Time::HiRes qw[ time ]; sub uniq{ my %h; undef @h{ @_ }; keys %h } my $start = time; our $Q //= 100; ## The maximum size of the Qs our $T //= 4; ## No of worker threads at both stages our $F //= '*.txt'; ## File selector for testing my $semFIO :shared; ## serialise disk access my $Qxmlin = threads::Q->new( $Q ); ## filenames to XML threads my $Qitems = threads::Q->new( $Q ); ## extracted items from XML threads async { ## "XML Parser" thread pool while( my $file = $Qxmlin->dq ) { my $xml = do{ lock $semFIO; local( @ARGV, $/ ) = $file; <> }; $Qitems->nq( join $;, split ' : ', $_ ) for split "\n", $xml; } $Qitems->nq( undef ); }->detach for 1 .. $T; async { ## Q up filenames for XML processing pool $Qxmlin->nq( glob "sha/$F" ); $Qxmlin->nq( (undef) x $T ); }->detach; my @items; ## Non-shared storage for extracted items for( 1 .. $T ) { ## Gather them all together push @items, $_ while defined( $_ = $Qitems->dq ); } undef $Qxmlin; undef $Qitems; ## Done with these. print STDERR scalar @items; ## Sanity check of items count. my $Qcmp = threads::Q->new( $Q ); ## Item pairs for comparison in my $Qsim = threads::Q->new( $Q ); ## Similar rated items out async { ## similarities assessment thread pool while( my $work = $Qcmp->dq ) { my( $key1, $val1, $key2, $val2 ) = split $;, $work; my %bigrams1; undef @bigrams1{ uniq unpack '(A2)*', $key1 }; my @bigrams2 = uniq unpack '(A2)*', $key2; my $count = grep exists( $bigrams1{ $_ } ), @bigrams2; my $sim = $count * 2 / ( keys( %bigrams1 ) + @bigrams2 ); $Qsim->nq( $work ) if $sim > 0.2; ## low-value required to allow my test data to generate hits. } $Qsim->nq( undef ); }->detach for 1 .. $T; async { ## Q up the pairs for comparison for my $i1 ( 0 .. $#items ) { my $item1 = $items[ $i1 ]; for my $i2 ( $i1 + 1 .. $#items ) { my $item2 = $items[ $i2 ]; $Qcmp->nq( "$item1$;$item2" ); } } $Qcmp->nq( (undef) x $T ); }->detach; ## gather together those that pass the criteria ## And do something with them. for( 1 .. $T ) { while( my $sim = $Qsim->dq ) { print $sim; } } printf STDERR "With T:$T Q:$Q took %.3f s\n", time - $start;