Ok, I think I understand your algorithm, it seems very similar to the LCSS idea I mentioned and showed, except you want to split words on underscores, and I think you want to compare each word exactly? (In that case, when comparing sbr_ux_side_clkack with ux_side_clk, the match would only be ux_side.)

I could implement your algorithm more or less literally, although in the following I haven't implemented the 50% rule you mentioned - it just picks the @array1 element with the best match, and also there is currently no protection against picking the same @array1 element twice. Instead of spliceing the @array2 elements, which is a destructive operation, I use different offsets. However, as you can tell, the whole thing gets kind of complex, plus, because of the four (!) nested loops, if the strings and/or arrays get longer, it will be less and less performant! But maybe this is a good starting point anyway.

By the way, @array1 and @array2 aren't very descriptive names, I recommend you choose some better (more descriptive) variable names.

use warnings;
use strict;
use Data::Dump qw/dd pp/;

my @array1 = ('ux_prim_clk', 'ux_side_clk', 'ux_xtal_frm_refclk');
my @array2 = ('ccu_ux_xtal_frm_refclk_ack', 'ibbs_ux_prim_clkack',
    'sbr_ux_side_clkack'); 

my @aoa1 = map { [ split /_/, $_ ] } @array1;
my @output;
# Using @array2 for the basis of ordering, so loop over that first
for my $a2 ( map { [ split /_/, $_ ] } @array2 ) {
    #print "##### "; dd $a2; # debug
    # Now look through @array1 for the best match
    my ($highest_match, $highest_match_at_a1idx) = (-1);
    for my $i ( 0 .. $#aoa1 ) { # in this loop, keep track of index
        my $a1 = $aoa1[$i];
        # The following code relies on @$a1 >= @$a2, so check that
        if ( @$a2 < @$a1 ) { warn "Skipping ".pp($a2, $a1); next }
        # Try matching $a1 against $a2 at different offsets
        for my $offset ( 0 .. @$a2 - @$a1 ) {
            my $match = 0;
            # Count the number of matching elements at each offset
            for my $j ( 0 .. $#$a1 ) {
                if ( $a2->[$offset+$j] eq $a1->[$j] ) { $match++ }
                else { last } # failed to match, stop looking
            }
            # If this index and offset matches better, record that
            if ( $match && $match > $highest_match ) {
                #dd $a2, $offset, $a1, $match; # debug
                $highest_match = $match;
                $highest_match_at_a1idx = $i;
            }
        }
    }
    if ( defined $highest_match_at_a1idx )
        { push @output, $array1[$highest_match_at_a1idx] }
    else { warn "Failed to find match for ".pp($a2) }
}

dd @array1; dd @array2; dd @output;

__END__

("ux_prim_clk", "ux_side_clk", "ux_xtal_frm_refclk")
(
  "ccu_ux_xtal_frm_refclk_ack",
  "ibbs_ux_prim_clkack",
  "sbr_ux_side_clkack",
)
("ux_xtal_frm_refclk", "ux_prim_clk", "ux_side_clk")
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.