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

Here's my straight forward solution, ungolfed...

# get prefix sub prefix { my @w = length($_[0]) > length($_[1]) ? reverse @_ : @_; my $len = 1; my $f; $len++ while $w = substr($w[0],0,$len) # and $w[1] =~ /^$w/ # no m// needed, index is fine and 0 == index( $w[1],$w) and $len <= length $w[0] and $f = $w; return if $f eq $w[0]; $f; } # get suffix sub suffix { my @w; push @w, scalar reverse($_) for @_; $ret = reverse prefix(@w); } while(<DATA>) { # DATA section contains names as per OP's link push @list, (split/,/)[0]; } # get prefixes and suffixes my (%names, %pre, %suf); $names{$_}++ for @list; # updated per [id://759430] while(@list) { my $first = $ARGV[0] || shift @list; # updated per [id://759430] # next if $names{$first}++; # store for convenient lookup for my $name (@list) { my $s = prefix($first,$name); ++$pre{$s}->{$first} and ++$pre{$s}->{$name} if $s; my $s = suffix($first,$name); ++$suf{$s}->{$first} and ++$suf{$s}->{$name} if $s; } last if $ARGV[0]; # updated per [id://759430] } # get pairings. Concatenate each prefix which each suffix # and see if it comes to a compliment, er, a complement # which can be looked up in the %names hash my @pre = keys %pre; my @suf = keys %suf; for my $pre(@pre) { for my $suf (@suf) { if ($names{$pre.$suf}) { print "found: prefix(@{[keys %{$pre{$pre}}]}) = $pre, " . "suffix(@{[keys %{$suf{$suf}}]}) = $suf, " . "$pre.$suf = $pre$suf\n"; } } }

which yields:

found: prefix(CHAKVETADZE CHAN) = CHA, suffix(GARBIN JOHANSSON COIN CH +AN TANASUGARN) = N, CHA.N = CHAN found: prefix(WOZNIAK WOZNIACKI) = WOZNIA, suffix(WOZNIAK CZINK PASZEK + SREBOTNIK) = K, WOZNIA.K = WOZNIAK found: prefix(WOZNIAK WOZNIACKI) = WOZNIA, suffix(WOZNIACKI LISICKI) = + CKI, WOZNIA.CKI = WOZNIACKI found: prefix(PETROVA PENG PEER PENNETTA) = PE, suffix(PENG ZHENG KEOT +HAVONG) = NG, PE.NG = PENG found: prefix(PETROVA PENG PEER PENNETTA) = PE, suffix(PARMENTIER WICK +MAYER PEER BAMMER SCHNYDER) = ER, PE.ER = PEER found: prefix(LISICKI LLAGOSTERA VIVES LI) = L, suffix(BARTOLI LI KANE +PI ERRANI VINCI WOZNIACKI REZAI LISICKI) = I, L.I = LI found: prefix(SAFAROVA SAFINA) = SAF, suffix(SAFAROVA MAKAROVA) = AROV +A, SAF.AROVA = SAFAROVA found: prefix(SAFAROVA SAFINA) = SAF, suffix(VESNINA DUSHEVINA SAFINA) + = INA, SAF.INA = SAFINA found: prefix(COIN CORNET) = CO, suffix(GARBIN COIN) = IN, CO.IN = COI +N found: prefix(PARMENTIER PETROVA PENG PENNETTA PIRONKOVA PASZEK PEER P +AVLYUCHENKOVA) = P, suffix(PENG ZHENG) = ENG, P.ENG = PENG

timed as

real 0m0.387s user 0m0.381s sys 0m0.003s

update: using Limbic~Region's name list I get

real 0m12.441s user 0m12.219s sys 0m0.015s

and replacing m// with index in sub suffix above

real 0m6.405s user 0m6.273s sys 0m0.007s

on a Pentium M 2.10GHz, perl 5.8.8 - What are your timings? What is "better"? Code readability, brevity, maintainability, performance?

;-)

Replies are listed 'Best First'.
Re^2: Challenge: prefix($x, $y) . suffix($x, $z) eq $x
by Limbic~Region (Chancellor) on Apr 22, 2009 at 22:18 UTC
    shmem,
    What is "better"?

    Bah, I was just baiting folks into contributing. I do see a syntax error in what you posted (last if block is missing closing curly)? After correcting that typo, it takes about 11 wallclock seconds to run the tennis name list. Thanks for your contribution :-)

    Cheers - L~R

      I do see a syntax error

      Thanks, corrected. - I seem to just have learned something about index: use it! Did cut the wallclock time to the half it did... ;-) ... see my update.

        shmem,
        This doesn't seem to scale very well. I started to run it against a 60K word dictionary file and I gave up waiting for it to produce output after a few minutes. Perhaps you could modify it to accept a target word from the command line and only do all matches if one isn't provided?

        Cheers - L~R