view release on metacpan or  search on metacpan

lib/Bio/ToolBox/utility.pm  view on Meta::CPAN

			# chromosome arms
			my $i = $1;
			my $a = lc $2;
			if ( $a eq 'l' ) {
				$i += 0.1;
			}
			elsif ( $a eq 'r' ) {
				$i += 0.2;
			}
			elsif ( $a eq 'p' ) {
				$i += 0.3;
			}
			elsif ( $a eq 'q' ) {
				$i += 0.4;
			}
			push @numeric, [ $i, $c ];
		}
		elsif ( $name =~ m/^ ( [a-zA-Z_\-\.]+ ) (\d+)/x ) {

			# presumed contigs and such?
			push @mixed, [ $1, $2, $name, $c ];
		}
		else {
			# everything else
			push @alphic, [ $name, $c ];
		}
	}

	# check romanic
	if ( scalar @romanic ) {

		# looks like we have romanic chromosomes
		if ( scalar @sex ) {

			# probably caught up chrX, unlikely WYZ
			my @x = grep { $sex[$_]->[0] =~ m/^X$/ } ( 0 .. $#sex );
			foreach ( reverse @x ) {

				# I'm assuming and hoping there's only one chrX found
				# but reverse the list, just in case - assuming grep returns in order
				push @romanic, ( splice( @sex, $_, 1 ) );
			}
		}
		if ( scalar @numeric ) {

			# well, shoot, this is weird, mix of both numeric and romanic chromosomes?
			# just merge romanic with alphic and hope for the best
			push @alphic, @romanic;
		}
		else {
			# convert the romanic to numeric
			while (@romanic) {
				my $r = shift @romanic;
				my $c = $r->[0];
				$c =~ s/IV/4/;
				$c =~ s/IX/9/;
				$c =~ s/V/5/;
				$c =~ s/I/1/g;
				my $n = 0;
				foreach ( split m//, $c ) {
					if ( $_ eq 'X' ) {
						$n += 10;
					}
					else {
						$n += $_;
					}
				}
				push @numeric, [ $n, $r->[1] ];
			}
		}
	}

	# sort
	my @sorted;
	push @sorted, map { $_->[1] } sort { $a->[0] <=> $b->[0] } @numeric;
	push @sorted, map { $_->[1] } sort { $a->[0] cmp $b->[0] } @sex;
	push @sorted, map { $_->[1] } sort { $a->[0] cmp $b->[0] } @mito;
	push @sorted, map { $_->[3] }
		sort { $a->[0] cmp $b->[0] or $a->[1] <=> $b->[1] or $a->[2] cmp $b->[2] } @mixed;
	push @sorted, map { $_->[1] } sort { $a->[0] cmp $b->[0] } @alphic;

	return @sorted;
}

1;

__END__

=head1 NAME

Bio::ToolBox::utility - common utility functions for Bio::ToolBox

=head1 DESCRIPTION

These are general subroutines that don't fit in with the other modules.

=head1 REGULAR SUBROUTINES

The following subroutines are automatically exported when you use this module.

=over 4

=item parse_list

	my $index_request = '1,2,5-7';
	my @indices = parse_list($index_request); # returns [1,2,5,6,7]

This subroutine parses a scalar value into a list of values. The scalar is 
a text string of numbers (usually column or dataset indices) delimited by 
commas and/or including a range. For example, a string "1,2,5-7" would become 
an array of [1,2,5,6,7].

Pass the module the scalar string.

It will return the array of numbers.

=item format_with_commas

	my $count = '4327908475';
	printf " The final count was %s\n", format_with_commas($count);