Lenoc3_duallayer_1
^^ ^ ^ ^
####
limit shortened
10 Lenoc3_du1
...
6 Len3d1
5 Le3d1
4 not possible
##
##
L -> XP_ -> 0 -> ...
-> 1 -> ...
-> enoc -> 3_ -> carina_ -> ...
-> duallayer_ -> ...
-> 5_ -> carina -> ...
-> duallayer -> ...
##
##
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 () {
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