package Microarray::File::Data::BlueFuse;
use 5.006;
use strict;
use warnings;
our $VERSION = '1.23';
require Microarray::File::Data;
sub auto_data_file {
('bluefuse_file','bluefuse');
}
{ package bluefuse_post_file;
our @ISA = qw( bluefuse_file );
# should include methods for getting/setting extra header info at some point
# for now, this class simply deals with the lack of some values in post files
sub man_excl {
return "no";
}
sub auto_excl {
return "no";
}
sub spot_index {
my $self = shift;
my $index = shift;
return ($index + 1);
}
}
{ package bluefuse_file;
our @ISA = qw( data_file );
# setter for { _spot_data }, { _data_fields } and { _header_info }
sub sort_data {
my $self = shift;
my $aaData = shift;
$self->set_header_info($aaData);
$self->set_data_fields(shift @$aaData);
$self->{ _spot_data } = $aaData; # all the numbers
$self->{ _spot_count } = scalar @$aaData;
}
# information about the scan
sub set_header_info {
my $self = shift;
my $aaData = shift;
my $hHeader_Info = { };
my ($flags,$qc);
while (my $aRow = shift @$aaData){
next unless (@$aRow);
if ($$aRow[0] eq 'ROW'){
unshift(@$aaData,$aRow);
last;
} elsif ($$aRow[0] =~ /#/){
next;
} elsif ($$aRow[0] =~ /^Created by/){
my $value = $$aRow[0];
$value =~ s/Created by //;
$hHeader_Info->{ VERSION } = $value;
} elsif ($$aRow[0] =~ /ARRAY QC START:/){
$qc++;
} elsif ($$aRow[0] =~ /ARRAY QC END:/){
$qc = undef;
} elsif ($qc) {
if ($$aRow[0] eq 'Confidence Flags (%)'){
$flags++;
} elsif ($flags){
$hHeader_Info->{ 'Confidence Flags (%)' } = {
A => $$aRow[2],
B => $$aRow[3],
C => $$aRow[4],
D => $$aRow[5],
E => $$aRow[6]
};
$flags = undef;
} else {
$hHeader_Info->{ $$aRow[0] } = $$aRow[3];
}
} else {
my ($key,$value) = split(/: /,$$aRow[0]);
if ($key eq 'CONFIDENCE FLAGS'){
my @aFlag_Estimates = split(/, /,$value);
my $hFlag_Ranges = { };
for my $flag_range (@aFlag_Estimates){
my ($start,$flag,$end) = split(/ < /,$flag_range);
$hFlag_Ranges->{ $flag } = [$start,$end];
}
$value = $hFlag_Ranges;
}
$hHeader_Info->{ $key } = $value;
}
}
$self->{ _header_info } = $hHeader_Info;
}
sub delimiter {
return "\t";
}
### header info getters ###
#Êbarcode not saved in bluefuse file
#Êhave to guess from data_file method
sub slide_barcode {
my $self = shift;
$self->guess_barcode;
}
sub analysis_software {
my $self = shift;
$self->get_header_info('VERSION');
}
sub build {
my $self = shift;
$self->get_header_info('BUILD');
}
sub date {
my $self = shift;
$self->get_header_info('DATE');
}
sub experiment {
my $self = shift;
$self->get_header_info('EXPERIMENT');
}
sub channel1_image_file {
my $self = shift;
$self->get_header_info('CH1');
}
sub channel2_image_file {
my $self = shift;
$self->get_header_info('CH2');
}
sub frame_ch1 {
my $self = shift;
$self->get_header_info('FRAME CH1');
}
sub frame_ch2 {
my $self = shift;
$self->get_header_info('FRAME CH2');
}
sub gal_file {
my $self = shift;
$self->get_header_info('GAL');
}
sub clone_file {
my $self = shift;
$self->get_header_info('CLONEFILE');
}
sub clone_text {
my $self = shift;
$self->get_header_info('CLONETEXT');
}
sub confidence_flag_range {
my $self = shift;
my $hFlags = $self->get_header_info('CONFIDENCE FLAGS');
if(@_){
my $flag = shift;
if (wantarray()) {
return @{ $hFlags->{ $flag } };
} else {
return $hFlags->{ $flag };
}
} elsif (wantarray()) {
return ($$hFlags{E}[0],$$hFlags{E}[1],$$hFlags{D}[1],$$hFlags{C}[1],$$hFlags{B}[1],$$hFlags{A}[1]);
} else {
return $hFlags; # a hashref
}
}
sub replicate_field {
my $self = shift;
return $self->get_header_info('IDENTIFY REPLICATES BY');
}
sub confidence_flag_percen {
my $self = shift;
my $hFlags = $self->get_header_info('Confidence Flags (%)');
if(@_){
my $flag = shift;
return $hFlags->{ $flag };
} elsif (wantarray()) {
return ($hFlags->{A},$hFlags->{B},$hFlags->{C},$hFlags->{D},$hFlags->{E});
} else {
return $hFlags; # a hashref
}
}
sub log_ratio_sd {
my $self = shift;
return $self->get_header_info('SD of Log2Ratio');
}
sub rep_median_sd {
my $self = shift;
return $self->get_header_info('Median SD Between Replicates');
}
sub mean_ch1_amp {
my $self = shift;
return $self->get_header_info('Mean Ch1 Spot Amplitude');
}
sub mean_ch2_amp {
my $self = shift;
return $self->get_header_info('Mean Ch2 Spot Amplitude');
}
sub sbr_ch1 {
my $self = shift;
return $self->get_header_info('SBR Ch1');
}
sub sbr_ch2 {
my $self = shift;
return $self->get_header_info('SBR Ch2');
}
sub array_columns {
my $self = shift;
if (@_){
$self->{ _array_columns } = shift;
} else {
unless (defined $self->{ _array_columns }){
$self->set_array_layout;
}
$self->{ _array_columns };
}
}
sub array_rows {
my $self = shift;
if (@_){
$self->{ _array_rows } = shift;
} else {
unless (defined $self->{ _array_rows }){
$self->set_array_layout;
}
$self->{ _array_rows };
}
}
sub spot_columns {
my $self = shift;
if (@_){
$self->{ _spot_columns } = shift;
} else {
unless (defined $self->{ _spot_columns }){
$self->set_array_layout;
}
$self->{ _spot_columns };
}
}
sub spot_rows {
my $self = shift;
if (@_){
$self->{ _spot_rows } = shift;
} else {
unless (defined $self->{ _spot_rows }){
$self->set_array_layout;
}
$self->{ _spot_rows };
}
}
# this only works if the array is sorted by block/spot
sub set_array_layout {
my $self = shift;
my $aaData = $self->spot_data;
my $block_row = $self->get_column_id('ROW');
my $block_col = $self->get_column_id('COL');
my $spot_row = $self->get_column_id('SUBGRIDROW');
my $spot_col = $self->get_column_id('SUBGRIDCOL');
my $aLast_Row = $aaData->[-1];
$self->array_columns($aLast_Row->[$block_col]);
$self->array_rows($aLast_Row->[$block_row]);
$self->spot_columns($aLast_Row->[$spot_col]);
$self->spot_rows($aLast_Row->[$spot_row]);
}
### data file fields ###
sub spot_index {
my $self = shift;
$self->return_data(shift,$self->get_column_id('SPOTNUM'));
}
sub block_row {
my $self = shift;
$self->return_data(shift,$self->get_column_id('ROW'));
}
sub block_col {
my $self = shift;
$self->return_data(shift,$self->get_column_id('COL'));
}
sub spot_row {
my $self = shift;
$self->return_data(shift,$self->get_column_id('SUBGRIDROW'));
}
sub spot_col {
my $self = shift;
$self->return_data(shift,$self->get_column_id('SUBGRIDCOL'));
}
sub block {
my $self = shift;
$self->return_data(shift,$self->get_column_id('BLOCK'));
}
sub feature_id {
my $self = shift;
$self->return_data(shift,$self->get_column_id('NAME'));
}
sub synonym_id {
my $self = shift;
$self->return_data(shift,$self->get_column_id('ID'));
}
sub confidence {
my $self = shift;
$self->return_data(shift,$self->get_column_id('CONFIDENCE'));
}
sub flag_id {
my $self = shift;
$self->return_data(shift,$self->get_column_id('FLAG'));
}
sub man_excl {
my $self = shift;
$self->return_data(shift,$self->get_column_id('MAN EXCL'));
}
sub auto_excl {
my $self = shift;
$self->return_data(shift,$self->get_column_id('AUTO EXCL'));
}
sub ch1_mean_f {
my $self = shift;
$self->channel1_signal(shift);
}
sub ch2_mean_f {
my $self = shift;
$self->channel2_signal(shift);
}
# fudge to return some kind of snr value where required
# quality=PONCH, which is a 0-1 measure of biological signal
sub channel1_snr {
my $self = shift;
$self->channel1_quality(shift);
}
sub channel2_snr {
my $self = shift;
$self->channel2_quality(shift);
}
sub channel1_signal {
my $self = shift;
$self->return_data(shift,$self->get_column_id('AMPCH1'));
}
sub channel2_signal {
my $self = shift;
$self->return_data(shift,$self->get_column_id('AMPCH2'));
}
# bluefuse doesn't return a % sat value,
# and actually can return a signal value higher than 65536
# if signal > 65536, we'll call that channel 100% saturated
sub channel1_sat {
my $self = shift;
if ($self->channel1_signal(shift) > 65536){
return 100;
} else {
return;
}
}
sub channel2_sat {
my $self = shift;
if ($self->channel2_signal(shift) > 65536){
return 100;
} else {
return;
}
}
sub ch1_median_b {
1
}
sub ch2_median_b {
1
}
sub ratio_ch1ch2 {
my $self = shift;
$self->return_data(shift,$self->get_column_id('RATIO CH1/CH2'));
}
sub ratio_ch2ch1 {
my $self = shift;
$self->return_data(shift,$self->get_column_id('RATIO CH2/CH1'));
}
sub log2ratio_ch1ch2 {
my $self = shift;
$self->return_data(shift,$self->get_column_id('LOG2RATIO CH1/CH2'));
}
sub log2ratio_ch2ch1 {
my $self = shift;
$self->return_data(shift,$self->get_column_id('LOG2RATIO CH2/CH1'));
}
sub log2_ratio {
my $self = shift;
if ($self->flip_flop == 1){
$self->log2ratio_ch1ch2(shift);
} else {
$self->log2ratio_ch2ch1(shift);
}
}
sub log10ratio_ch1ch2 {
my $self = shift;
$self->return_data(shift,$self->get_column_id('LOG10RATIO CH1/CH2'));
}
sub log10ratio_ch2ch1 {
my $self = shift;
$self->return_data(shift,$self->get_column_id('LOG10RATIO CH2/CH1'));
}
sub sumch1ch2 {
my $self = shift;
$self->return_data(shift,$self->get_column_id('SUM'));
}
sub log2sum {
my $self = shift;
$self->return_data(shift,$self->get_column_id('LOG2SUM'));
}
sub log10sum {
my $self = shift;
$self->return_data(shift,$self->get_column_id('LOG10SUM'));
}
sub product {
my $self = shift;
$self->return_data(shift,$self->get_column_id('PRODUCT'));
}
sub log2product {
my $self = shift;
$self->return_data(shift,$self->get_column_id('LOG2PRODUCT'));
}
sub log10product {
my $self = shift;
$self->return_data(shift,$self->get_column_id('LOG10PRODUCT'));
}
sub y_pos {
my $self = shift;
$self->return_data(shift,$self->get_column_id('PELROW'));
}
sub x_pos {
my $self = shift;
$self->return_data(shift,$self->get_column_id('PELCOL'));
}
sub channel1_quality {
my $self = shift;
$self->return_data(shift,$self->get_column_id('P ON CH1'));
}
sub channel2_quality {
my $self = shift;
$self->return_data(shift,$self->get_column_id('P ON CH2'));
}
sub spot_diameter {
my $self = shift;
return 2*($self->return_data(shift,$self->get_column_id('RADIUS')));
}
sub uniformity {
my $self = shift;
$self->return_data(shift,$self->get_column_id('UNIFORMITY'));
}
sub circularity {
my $self = shift;
$self->return_data(shift,$self->get_column_id('CIRCULARITY'));
}
sub grid_offset {
my $self = shift;
$self->return_data(shift,$self->get_column_id('GRID OFFSET'));
}
sub quality {
my $self = shift;
$self->return_data(shift,$self->get_column_id('QUALITY'));
}
sub chromosome {
my $self = shift;
$self->return_data(shift,$self->get_column_id('CHROMOSOME'));
}
sub position {
my $self = shift;
$self->return_data(shift,$self->get_column_id('POSITION'));
}
sub cyto_locn {
my $self = shift;
$self->return_data(shift,$self->get_column_id('CYTO LOCN'));
}
sub display {
my $self = shift;
$self->return_data(shift,$self->get_column_id('DISPLAY'));
}
sub omim {
my $self = shift;
$self->return_data(shift,$self->get_column_id('OMIM'));
}
sub disease {
my $self = shift;
$self->return_data(shift,$self->get_column_id('DISEASE'));
}
sub gc_content {
my $self = shift;
$self->return_data(shift,$self->get_column_id('GC CONTENT'));
}
sub bad_flags {
{ 'D'=>'1', 'E'=>'1' };
}
}
1;
__END__
=head1 NAME
Microarray::File::Data::BlueFuse - A Perl module for managing BlueFuse 'output' files
=head1 SYNOPSIS
use Microarray::File::Data::BlueFuse;
my $data_file = bluefuse_file->new("/file.csv");
=head1 DESCRIPTION
Microarray::File::Data::BlueFuse is an object-oriented Perl module for managing microarray files created by BlueGnome's (L<http://www.bluegnome.co.uk/>) 'BlueFuse' software. It inherits from L<Microarray::File|Microarray::File>, and maps data fields in a BlueFuse 'output' data file to those used by L<Microarray::File::Data|Microarray::File::Data>.
=head1 METHODS
=head2 General Header Information
=over
=item B<analysis_software>, B<build>, B<experiment>, B<frame_ch1>, B<frame_ch2>, B<gal_file>, B<clone_file>, B<clone_text>, B<channel1_image_file>, B<channel2_image_file>
These methods all return the relevant header information as a scalar.
=item B<confidence_flag_range>, B<confidence_flag_range($flag)>
Returns the confidence estimate range for each confidence flag. Passing a flag as an argument returns C<($start,$end)> for that flag. Alternatively if a list is requested it will return each division, starting at 0 and ending at 1, else will return a hashref of keys A to E and the range as an arrayref C<[$start,$end]>.
=item B<slide_barcode>
Odd - BlueFuse does not return the barcode in the file header. So it has to guess it using the data_file method C<guess_barcode()>. Have asked the nice people at BlueGnome if they can fix this, and apparently they might, one day.
=back
=head2 Array QC Header Information
=over
=item B<confidence_flag_percen>, B<confidence_flag_percen($flag)>
Returns the percentage of spots with each confidence flag. Passing a flag as an argument returns only the value for that flag. Alternatively if a list is requested it will return a list of values for flags A to E, else will return a hashref of keys A to E and their respective flag values.
=item B<log_ratio_sd>, B<rep_median_sd>, B<mean_ch1_amp>, B<mean_ch2_amp>, B<sbr_ch1>, B<sbr_ch2>
These methods all return the relevant header information as a scalar.
=back
=head2 Spot Information
Pass a spot index to any of these methods to retrieve the relevant value for that spot.
=over
=item B<block_row>, B<block_col>, B<spot_row>, B<spot_col>
The ROW, COL, SUBGRIDROW and SUBGRIDCOL columns - describing the grid location of the spot.
=item B<feature_id>, B<synonym_id>
The NAME and ID columns - the unique identifiers of each spotted feature.
=item B<confidence>, B<flag_id>, B<man_excl>, B<auto_excl>
The CONFIDENCE, FLAG, MAN EXCL and AUTO EXCL columns. Flag confidence estimates can be returned separately (see above).
=item B<ch1_mean_f>, B<ch2_mean_f>, B<channel1_signal>, B<channel2_signal>
Actually return the AMPCH1 and AMPCH2 columns - the spot signal. The C<ch_mean_f> methods are provided for compatibility with other modules which calculate signal and background separately, and in which the calculated signal is returned using the methods C<channel1_signal> and C<channel2_signal>. As a result, the methods C<ch1_median_b> and C<ch2_median_b> are also provided in this module, but will always return '0'. However, other values for signal and background (such as C<snr, median_f, sd_f, mean_b> and C<sd_b>) are not returned and will generate an error.
=item B<x_pos>, B<y_pos>
The PELROW and PELCOL columns - the spot coordinates, returning the top/left position of the spot.
=item B<channel1_quality>, B<channel2_quality>
The P ON CH1 and P ON CH2 columns - estimates of the baysian probability that a biological signal is present in each channel
=item B<spot_diameter>, B<uniformity>, B<circularity>, B<grid_offset>, B<quality>
The 2*(RADIUS), UNIFORMITY, CIRCULARITY, QUALITY and GRID OFFSET columns.
=back
=head1 FUTURE DEVELOPMENT
At some point I plan to make this compatible with all of the BlueFuse file formats. While it has currently only been tested with the 'output' format, it might work with the other files.
=head1 TESTING
This distribution does not include a data file for testing purposes, since the one used for the test is very large. If you would like to run the full test you can download the file at L<http://www.instituteforwomenshealth.ucl.ac.uk/trl/pipeline/download.html>.
=head1 SEE ALSO
L<Microarray|Microarray>, L<Microarray::File|Microarray::File>, L<Microarray::File::Data|Microarray::File::Data>
=head1 AUTHOR
Christopher Jones, Gynaecological Cancer Research Laboratories, Institute for Women's Health, University College London.
L<http://www.instituteforwomenshealth.ucl.ac.uk/AcademicResearch/Cancer/trl>
c.jones@ucl.ac.uk
=head1 COPYRIGHT AND LICENSE
Copyright 2008 by Christopher Jones, University College London
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut