view release on metacpan or  search on metacpan

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

		}

		# remember for next time
		$DATA_FILENAME = $Data->filename;
		$DATA_COLNAMES = join( ';', $Data->list_columns );
	}

	# get response
	my $response = prompt($line);
	my @indices  = parse_list($response);

	# verify
	my @good;
	my $n = $Data->number_columns;
	foreach my $i (@indices) {
		if ( $i =~ /^\d+$/ and $i > 0 and $i <= $n ) {
			push @good, $i;
		}
		else {
			print "  $i is not a valid index!\n";
		}
	}
	return wantarray ? @good : $good[0];
}

sub simplify_dataset_name {
	my $dataset = shift;
	my $new_name;

	# strip any file prefix
	$dataset =~ s/^(?: file | http | ftp ):\/*//x;

	if ( $dataset =~ /&/ ) {

		# a combination dataset
		foreach ( split /&/, $dataset ) {
			my $n = simplify_dataset_name($_);
			if ($new_name) {
				$new_name .= '&' . $n;
			}
			else {
				$new_name = $n;
			}
		}
	}
	else {
		# a single dataset
		# this could be either a file name or an entry in a BioPerl or BigWigSet database
		# remove any possible paths
		( undef, undef, $new_name ) = File::Spec->splitpath($dataset);

		# remove any known file extensions
		$new_name =~
s/\. (?: bw | bam | bb | useq | bigwig | bigbed | g[tf]f3? | cram | wig | bdg | bedgraph ) (?:\.gz)? $//xi;

		# remove common non-useful stuff
		# trying to imagine all sorts of possible things
		$new_name =~
s/[_\.\-] (?: sort | sorted | dedup | dedupe | deduplicated | rmdup | mkdup | markdup | dup | unique | filt | filtered ) \b //xgi;
		$new_name =~
s/[_\.\-] (?: coverage | rpm | ext\d* | extend\d* | log2fe | log\d+ | qvalue | fragment | count | lambda_control | fe | fold.?enrichment | ratio | log\d*ratio ) \b //xgi;
	}
	return $new_name;
}

sub sane_chromo_sort {
	my @chroms = @_;
	return unless scalar @chroms;

	# let's try and sort in some kind of rational order
	my @numeric;
	my @romanic;
	my @mixed;
	my @alphic;
	my @sex;
	my @mito;
	foreach my $c (@chroms) {

		my $name;
		if ( ref($c) eq 'ARRAY' ) {
			$name = $c->[0];
		}
		else {
			$name = $c;
		}

		# identify the type of chromosome name to sort
		if ( $name =~ m/^ (?:chr)? ( [wxyz] ) $/xi ) {

			# sex chromosomes
			push @sex, [ $1, $c ];
		}
		elsif ( $name =~ m/^ (?:chr)? (?: m | mt | mito ) (?:dna)? $/xi ) {

			# mitochondrial
			push @mito, [ $name, $c ];
		}
		elsif ( $name =~ m/^ \d+ $/x and length($name) > 2 ) {

			# I'm going to go out on a limb here and presume this is some weird scaffold
			# since it's unlikely or at least rare for organisms to have over 100
			# numbered chromosomes. For example, Drosophila BDGP6 has a whole bunch of
			# scaffolds with just numbers.
			# Push these to mixed and hope for the best
			push @mixed, [ q( ), $name, $name, $c ];
		}
		elsif ( $name =~ m/^ (?:chr)? (\d+) $/xi ) {

			# standard numeric chromosome
			push @numeric, [ $1, $c ];
		}
		elsif ( $name =~ m/^ (?:chr)? ( [IVX]+ ) $/x ) {

			# Roman numerals - silly Saccharomyces cerevisiae
			push @romanic, [ $1, $c ];
		}
		elsif ( $name =~ m/^ (?:chr)? ( \d+ ) ( [lrpq] ) $/xi ) {

			# chromosome arms
			my $i = $1;
			my $a = lc $2;