view release on metacpan or  search on metacpan

scripts/data2wig.pl  view on Meta::CPAN

			# we can write directly to utility
			# print " $bw_app_path supports stdin, can write directly\n";
			$post_bw_convert = 0;
		}
		else {
			# we cannot write directly to utility
			# print " $bw_app_path does not support stdin, will write temp wig file\n";
			$post_bw_convert = 1;
			$gz              = 0;
		}

		# if we're generating bigwig file, no track is needed
		$use_track = 0;

		# check that we have a source for chromosome info
		unless ( $database or $chromo_file ) {
			$database = $Input->database
				or die
" No database name or chromosome file provided for generating bigwig file!\n";
		}
	}
	else {
		print " No external bigWig utility available, writing wig format\n";
		$bigwig = 0;
	}
}

sub set_method_sub {

	# for combining values from duplicate positions we need a method
	if ( $method eq 'mean' ) {
		return sub { return sum0(@_) / ( scalar(@_) || 1 ); };
	}
	elsif ( $method eq 'median' ) {
		return \&median;
	}
	elsif ( $method eq 'sum' ) {
		return \&sum0;
	}
	elsif ( $method eq 'max' ) {
		return \&max;
	}
	else {
		print STDERR " FATAL: unrecognized method 'method'!\n";
		exit 1;
	}
}

sub set_score_sub {
	if ( $attribute_name and $Input->gff ) {

		# a GFF attribute
		return sub {
			my $row     = shift;
			my $attribs = $row->gff_attributes;
			my $score   = $attribs->{$attribute_name} || 0;
			return if $score eq '.';

			# format as necessary
			$score =~ s/\%$//;    # remove stupid percents if present
			return $score;
		};
	}
	elsif ( $attribute_name and $Input->vcf and defined $score_index ) {

		# a VCF attribute from one sample
		return sub {
			my $row     = shift;
			my $attribs = $row->vcf_attributes;
			my $score   = $attribs->{$score_index}{$attribute_name} || 0;
			return 0 if $score eq '.';

			# format as necessary
			$score =~ s/\%$//;    # remove stupid percents if present
			return $score;
		};
	}
	elsif ( $attribute_name and $Input->vcf and @score_indices ) {

		# a VCF attribute from many samples
		return sub {
			my $row     = shift;
			my $attribs = $row->vcf_attributes;
			my @scores;
			foreach (@score_indices) {
				my $s = $attribs->{$_}{$attribute_name} || 0;
				$s =~ s/\%$//;    # remove stupid percents if present
				if ( looks_like_number($s) ) {
					push @scores, $s;
				}
			}
			return &{$method_sub}(@scores);
		};
	}
	elsif ( @score_indices and $fast ) {

		# collect over multiple score columns from array reference
		return sub {
			my $data = shift;
			my @v    = grep { looks_like_number($_) } map { $data->[$_] } @score_indices;
			return &{$method_sub}(@v);
		};
	}
	elsif ( @score_indices and not $fast ) {

		# collect over multiple score columns from Feature row object
		return sub {
			my $row = shift;
			my @v =
				grep { looks_like_number($_) } map { $row->value($_) } @score_indices;
			return &{$method_sub}(@v);
		};
	}
	elsif ( defined $score_index and $fast ) {

		# collect from a single score column
		return sub {
			return shift->[$score_index] || 0;
		};
	}
	elsif ( defined $score_index and not $fast ) {

		# collect from a single score column
		return sub {
			my $row = shift;
			return $row->value($score_index) || 0;
		};
	}
	else {
		die "programmer error! how did we get here?\n";
	}
}

sub set_print_string {

	# set the printf format string depending on type of wig file
	if ( $step eq 'fixed' ) {
		return defined $format ? '%.' . $format . "f\n" : "%s\n";
	}
	elsif ( $step eq 'variable' ) {
		return defined $format ? '%d %.' . $format . "f\n" : "%s %s\n";
	}
	elsif ( $step eq 'bed' ) {
		return defined $format ? "%s\t%d\t%d\t%." . $format . "f\n" : "%s\t%d\t%d\t%s\n";
	}
}