Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

Another idea probably worth mentioning: embrace tab completion. Let's suppose we can use tab completion on your input, for instance consider this line:

Lenoc3_duallayer_1 ^^ ^ ^ ^

You must type the marked characters, but the others are optional, they can be completed by pressing tab. Therefore in the shortening process always keep the mandatory characters, but leave out as many optional as needed starting from the right end.

limit shortened 10 Lenoc3_du1 ... 6 Len3d1 5 Le3d1 4 not possible

This is achievable by parsing your input into a suffix tree and operating on that.

L -> XP_ -> 0 -> ... -> 1 -> ... -> enoc -> 3_ -> carina_ -> ... -> duallayer_ -> ... -> 5_ -> carina -> ... -> duallayer -> ...

The first characters of the tree node strings are the mandatory ones, the others are optional. This tree structure seems similar to ikegami's code, however I haven't understood that fully yet, so I'm not sure what's the difference. For me the benefit of this approach seems to be this: you don't need to use the concept of word. Another pro for this algorithm is that you don't need to number your shortened identifiers. (But numbering your input lines (in the base of your input character set) is not bad because that produces the shortest possible unique ids.)

I have some proof of concept code, but take it with a grain of salt: it's unnecessarily complex, employs dirty hacks etc.

use strict; use warnings; use Data::Dump qw( dd ); sub _collapse { my $tree = shift; my ( $stree, $append ); if ( ref $tree ) { my @keys = keys %$tree; if ( @keys == 1 and $keys[0] ne '' ) { ( $stree, $append ) = _collapse( $tree->{ $keys[0] } ); return $stree, defined $append ? $keys[0] . $append : $keys[0]; } else { for (@keys) { ( my $ref, $append ) = _collapse( $tree->{$_} ); $stree->{ defined $append ? $_ . $append : $_ } = $ref; } return $stree; } } return; } sub collapse { my $ctree = shift; my ( $stree, $append ) = _collapse($ctree); if ( defined $append ) { return { $append => $stree }; } else { return $stree; } } sub shorten { my $stree = shift; my $limit = shift; if ( ref $stree ) { while ( my ( $k, $v ) = each %$stree ) { local our @parts = @parts; push @parts, $k if $k ne ''; if ( $k eq '' ) { if ( @parts > $limit ) { print "!\n"; next; } my $remaining = $limit - @parts; my $shortened = ''; for ( 0 .. $#parts ) { $shortened .= substr $parts[$_], 0, 1; my $str = substr $parts[$_], 1, $remaining; $shortened .= $str; last if ( ( $remaining -= length $str ) < 0 ); } print $shortened, "\t", join( '', @parts ), "\n"; } shorten( $v, $limit ); } } } my $ctree = {}; while (<DATA>) { chomp; my $ref = $ctree; for ( split // ) { no warnings 'void'; $ref->{$_}->{''}; # looks like a decent autovivification bug ;-) $ref = $ref->{$_}; } $ref->{''} = undef; } #dd $ctree; my $stree = collapse($ctree); #dd $stree; shorten( $stree => 5 ); __DATA__ A2990_duallayer_1 A2990_duallayer_2 A2990_duallayer_3 A2990_duallayer_4 A2990_duallayer_5 A2990_duallayer_6 A2990_duallayer_7 A2990_duallayer_8 A2990_duallayer_9 A2990_duallayer_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 Normal_1 Normal_2 Normal_3 Normal_4 Normal_5 Normal_6 Lenoc3_carina_A Lenoc3_carina_B Lenoc3_carina_C Lenoc3_duallayer_1 Lenoc3_duallayer_2 Lenoc3_duallayer_3 Lenoc5_carina_1 Lenoc5_carina_2 Lenoc5_carina_3 Lenoc5_duallayer_1 Lenoc5_duallayer_2 Lenoc5_duallayer_3

Some explanation: I've started by parsing the input into a character-level suffix tree. This tree uses hashes, the keys are the substrings, the values are hashrefs of what can follow. A possible ending position of the string is marked by "" => undef. Then collapsed it to a substring-level suffix tree and descended into that to shorten the ids.

Sorry for the late post, yesterday I haven't got enough time to write this.

p.s.: Am I right this is guaranteed to produce unique ids? I'm not sure, but it seems good.

update: answered my own question: Yes, the uniqueness of the shortened ids is guaranteed, no matter what set of optional characters are left out.


In reply to Re: Generate unique ids of maximum length by rubasov
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!
  • 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, 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, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            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.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others having an uproarious good time at the Monastery: (13)
    As of 2014-09-23 12:42 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      How do you remember the number of days in each month?











      Results (220 votes), past polls