Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re^2: Challenge: prefix($x, $y) . suffix($x, $z) eq $x

by Limbic~Region (Chancellor)
on Apr 22, 2009 at 22:11 UTC ( [id://759424]=note: print w/replies, xml ) Need Help??


in reply to Re: Challenge: prefix($x, $y) . suffix($x, $z) eq $x
in thread Challenge: prefix($x, $y) . suffix($x, $z) eq $x

BrowserUk,
I believe you have the requirements spot on. I agree it wasn't much of a "challenge" but I like to keep such posts similarly named for searching purposes later. When blokhead first described the problem he was mentioning possibly using suffix trees and other doodads which made me wonder how other people would approach it.

Update: The number of matches came as a big suprise to blokhead so I like the way you consolidated results. The reason I limited the matching to a single input was because of the enormous amount of output when doing all possible matches as blokhead first asked for though I coded it to find all matches. Would your approach have changed if you were doing all matches not just one for the input provided?

Cheers - L~R

Replies are listed 'Best First'.
Re^3: Challenge: prefix($x, $y) . suffix($x, $z) eq $x
by BrowserUk (Patriarch) on Apr 23, 2009 at 00:44 UTC
    Would your approach have changed if you were doing all matches not just one for the input provided?

    Of necessity it would have to change a bit if it were going to look up more than one word per run. I saved a litte time by pre-filtering the pre/suffix hashes to avoid storing prefixed that would contravene the longest prefix only rules. That means those hashes are specific to the word being dealt with. To match more than one word per run, requires deferring the filtering until later.

    Here's my first attempt at that. It deals with the tennis players file in under 1/3 seconds, so I've made no attempt to optimise it:

    #! perl -sw use 5.010; use strict; use Time::HiRes qw[ time ]; use Data::Dump qw[ pp ]; my $start = time; die "Need words filename" unless @ARGV and -e $ARGV[ 0 ]; open WORDS, '<', $ARGV[ 0 ] or die $!; chomp( my @words = <WORDS> ); close WORDS; my( %pre, %suf ); for ( @words ) { for my $p ( 1 .. length() -1 ) { push @{ $pre{ substr $_, 0, $p } }, $_; push @{ $suf{ substr $_, - $p } }, $_; } } for my $word ( @words ) { for my $p ( 1 .. length( $word ) - 1 ) { my $pre = substr $word, 0, $p; my $prePlus = substr $word, 0, $p+1; my $suf = substr $word, -( length( $word ) - $p ); my $sufPlus = substr $word, -( length( $word ) - ( $p-1 ) ); if( exists $pre{ $pre } and exists $suf{ $suf } ) { my @pre = grep{ !/^$prePlus/ } @{ $pre{ $pre } }; next unless @pre; my @suf = grep{ !/$sufPlus$/ } @{ $suf{ $suf } }; next unless @suf; say "$pre . $suf = $word"; printf "\t$pre ( %s )\n", @pre <= 10 ? join( ' ', @pre ) : join( ' ', @pre[ 0 .. 9 ], '... ' . @pre ); printf "\t$suf ( %s )\n", @suf <= 10 ? join( ' ', @suf ) : join( ' ', @suf[ 0 .. 9 ], '... ' . @suf ); } } } printf STDERR "Took: %.2f seconds\n", time() -$start; __END__ C:\test>759369 players.txt >nul Took: 0.29 seconds C:\test>759369 players.txt a . hn = ahn a ( abramovic adamczak afinogenova aguilar akiki akita alawi a +lbanese albuquerque aleksandrova ... 43 ) hn ( mohn ) aki . ki = akiki aki ( akita ) ki ( dabrowski filipovski jovanovski kitazaki lisicki miyazaki + solanki wozniacki ) aki . ta = akita aki ( akiki ) ta ( costa konta namigata pennetta tananta yokota zanchetta ) ... w . ong = wong w ( wang wannasuk warburton washington webleysmith weidemann w +einhold wejnert welford westbury ... 20 ) ong ( hong jeong keothavong tangphong zhong ) wo . ng = wong wo ( woerle wowchuk wozniacki wozniak ) ng ( chang cheng chuang frilling haring herring huang hwang ka +ng king ... 16 ) woznia . cki = wozniacki woznia ( wozniak ) cki ( lisicki ) woznia . k = wozniak woznia ( wozniacki ) k ( antoniychuk black blank buryachok czink ewijk fink fitzpat +rick gawlik grajdek ... 29 ) x . i = xi x ( xu ) i ( akiki alawi alnabhani andrei ani appineni arai bai balducc +i bartoli ... 93 ) x . ie = xie x ( xu ) ie ( binnie delefortrie elie ) x . u = xu x ( xi xie ) u ( anghelescu begu buzarnescu cadantu daniilidou dulgheru faf +aliou georgatou gerasimou hincu ... 28 ) ... z . hong = zhong z ( zabala zafirova zagorska zahlavova zahlavovastrycova zaja +zakopalova zanchetta zaniewska zecpeskiric ... 17 ) hong ( tangphong ) zh . ong = zhong zh ( zhang zhao zharkova zheng ) ong ( jeong keothavong wong ) zho . ng = zhong zho ( zhou ) ng ( chang cheng chuang frilling haring herring huang hwang ka +ng king ... 16 ) zh . ou = zhou zh ( zhang zhao zharkova zheng ) ou ( daniilidou fafaliou georgatou gerasimou ) zho . u = zhou zho ( zhong ) u ( anghelescu begu buzarnescu cadantu dulgheru hincu hisamats +u hsu liu lu ... 24 ) zo . ric = zoric zo ( zotter zovko ) ric ( majeric njiric zecpeskiric ) Took: 3.79 seconds

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://759424]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others studying the Monastery: (3)
As of 2024-03-19 11:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found