A2990_du_1
A2990_du_2
A2990_du_3
A2990_du_4
A2990_du_5
A2990_du_6
A2990_du_7
A2990_du_8
A2990_du_9
A2990_du_10
LXP_01
LXP_02
LXP_03
LXP_04
LXP_05
LXP_06
LXP_07
LXP_08
LXP_09
LXP_10
LXP_11
LXP_12
LXP_13
LXP_14
LXP_15
LXP_16
LXP_17
LXP_18
Len3_ca_A
Len3_ca_B
Len3_ca_C
Len3_du_1
Len3_du_2
Len3_du_3
Len5_ca_1
Len5_ca_2
Len5_ca_3
Len5_du_1
Len5_du_2
Len5_du_3
No_1
No_2
No_3
No_4
No_5
No_6

[download]

can be obtained using the following: 

use strict;
use warnings;

sub add {
    my $p = \shift;
    $p = \( $$p->{$_} ) for @_;
    $$p->{''} = 1;
}

sub shorten_unsplit {
    our $fixed;   local *fixed   = \$_[0];
    our $unsplit; local *unsplit = \$_[1];
    for ($unsplit) {
        if ( s/^([^A-Za-z]+[A-Za-z]?)// ) { $fixed .= $1; redo; }
        if ( s/^(?=(.))[A-Z]*[a-z]*//s  ) { $fixed .= $1; redo; }
    }
}

sub shorten {
    my @results;
    local *helper = sub {
        my ($trie, $fixed, $unsplit) = @_;
        my $single = ( keys(%$trie) == 1 );
        shorten_unsplit($fixed, $unsplit)
            if !$single || exists($trie->{''});
        for my $key (
            sort {; no warnings 'numeric'; $a <=> $b || $a cmp $b }
             keys(%$trie)
        ) {
            if ($key eq '') {
                push @results, $fixed;
            } elsif ($single) {
                helper($trie->{$key}, $fixed, "$unsplit$key");
            } else {
                helper($trie->{$key}, "$fixed$key", '');
            }
        }
    };

    my $trie;
    add($trie, /\d+|./sg) for @_;
    return if !$trie;
    helper($trie, '', '');
    return @results;
}

{
    chomp( my @data = <DATA> );
    print("$_\n") for shorten(@data);
}

__DATA__
...

[download]

Useful test case: Add A2990_dualplayer_10.

The code can manipulated to remove less when desired.

Update: Fixed a bug.
Update: And another.
Update: Improved sorting (1,2,...,9,10 vs 1,10,2,...,9).
Update: Input strings can now be substrings of other input strings. Simplified code at the same time.

In reply to Re: Generate unique ids of maximum length by ikegami
in thread Generate unique ids of maximum length by lima1

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • 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! —
  • 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:
    & &amp;
    < &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.