view release on metacpan or  search on metacpan

lib/Algorithm/TrunkClassifier/DataWrapper.pm  view on Meta::CPAN

	close(SUPP_FILE);
	
	#Extract classification variable names
	my @classNames = split(/\t/, shift(@suppFile));
	my $numCols = scalar(@classNames);
	shift(@classNames);
	if($numCols < 2){
		warn "Warning: No classification variable names found in supplementary file\n";
		return $dataFileName;
	}
	foreach my $className (@classNames){
		$className = uc($className);
	}
	my %classes;
	foreach my $classVar (@classNames){
		$classes{$classVar} = {};
	}
	
	#Determine classes of each classification variable and assign classes to samples
	my %sampleClasses;
	for(my $lineIndex = 0; $lineIndex < scalar(@suppFile); $lineIndex++){
		if($suppFile[$lineIndex] =~ /^\s*$/){
			next;
		}
		my @cols = split(/\t/, $suppFile[$lineIndex]);
		if(scalar(@cols) != $numCols){
			$lineIndex++;
			die "Error: Wrong number of columns in supplmentary file at line $lineIndex\n";
		}
		my $sampleName = uc(shift(@cols));
		$sampleName =~ s/\s+//g;
		if(!$sampleName){
			$lineIndex++;
			die "Error: Missing sample name in supplmentary file at line $lineIndex\n";
		}
		for(my $classVarIndex = 0; $classVarIndex < scalar(@classNames); $classVarIndex++){
			my $class = uc($cols[$classVarIndex]);
			$class =~ s/\s+//g;
			if(!$class){
				my $lineWarn = $classVarIndex + 1;
				warn "Warning: Missing class in supplmentary file at line $lineWarn, replacing with #NA\n";
				$class = $NULL_CLASS;
			}
			$sampleClasses{$sampleName}[$classVarIndex] = $class;
			if($class ne $NULL_CLASS && !$classes{$classNames[$classVarIndex]}{$class}){
				$classes{$classNames[$classVarIndex]}{$class} = 1;
			}
		}
	}
	foreach my $classVar (keys(%classes)){
		if(scalar(keys(%{$classes{$classVar}})) != 2){
			die "Error: Class variable $classVar in supplementary file does not have two classes\n";
		}
	}
	if(!%sampleClasses){
		warn "Warning: No sample classes found in supplementary file\n";
		return $dataFileName;
	}
	
	#Read input data file and write new data file with classification info
	open(DATA_FILE, $dataFileName) or die "Unable to open $datasetType '$dataFileName'\n";
	my @dataFile = <DATA_FILE>;
	close(DATA_FILE);
	my @header = split(/\t/, $dataFile[0]);
	shift(@header);
	chomp(@header);
	foreach my $sampleName (@header){
		$sampleName = uc($sampleName);
		$sampleName =~ s/\n|\r//g;
	}
	$dataFileName =~ s/\.[^.]+$/_wmeta.txt/;
	if($VERBOSE){
		print("Trunk classifier: Supplementary file supplied, writing new $datasetType with meta data\n");
	}
	open(DATA_FILE, ">$dataFileName") or die "Unable to create new data file '$dataFileName'\n";
	my $meta = "";
	for(my $classVarIndex = 0; $classVarIndex < scalar(@classNames); $classVarIndex++){
		my $className = $classNames[$classVarIndex];
		my @classKeys = keys(%{$classes{$className}});
		$meta .= "#CLASSVAR $className @classKeys\n";
		$meta .= "#CLASSMEM $className";
		foreach my $sampleName (@header){
			if(!$sampleClasses{$sampleName}[$classVarIndex]){
				warn "Warning: Sample '$sampleName' has no '$className' class in supplementary file\n";
				$meta .= " " . "#NA";
			}
			else{
				$meta .= " " . $sampleClasses{$sampleName}[$classVarIndex];
			}
		}
		$meta .= "\n";
	}
	print(DATA_FILE $meta . join("", @dataFile));
	close(DATA_FILE);
	return $dataFileName;
}

#Description: Reads input data file with expression values and meta data
#Parameters: (1) TrunkClassifier::DataWrapper object, (2) classification variable name
#            (3) prospect flag, (4) input data file name, (5) dataset type
#Return value: None
sub readExpData($ $ $ $ $){
	my ($self, $className, $prospect, $dataFileName, $datasetType) = @_;
	$className = uc($className);
	
	#Read input data file
	if(!open(DATA_FILE, $dataFileName)){
		die "Error: Unable to open $datasetType '$dataFileName'\n";
	}
	my @dataFile = <DATA_FILE>;
	close(DATA_FILE);
	my $content = join("", @dataFile);
	$content =~ s/\r|\n\r|\r\n/\n/g;
	@dataFile = split(/\n+/, $content);

	foreach my $row (@dataFile){
		$row =~ s/\n//g;
	}
	
	#Extract meta data rows
	my @metarows;
	my $rowcounter = 0;
	while($rowcounter < scalar(@dataFile)){
		$dataFile[$rowcounter] =~ s/^\s+//;
		if($dataFile[$rowcounter] =~ /^\s*$/){
			shift(@dataFile);
		}
		elsif($dataFile[$rowcounter] =~ /^#/){
			push(@metarows, shift(@dataFile));
		}
		else{
			$rowcounter++;
		}
	}
	
	#Extract samples
	my @samples = split(/\t/, shift(@dataFile));
	shift(@samples);
	my $totNumSamples = scalar(@samples);
	if(!$totNumSamples){
		die "Error: No samples in $datasetType\n";
	}
	
	#Check that class variable exists and that all samples have valid class membership
	my %classes;
	my %membership;
	foreach my $row (@metarows){
		if($row =~ /^#CLASSVAR/){
			my @cols = split(/\s+/, $row);
			shift(@cols);
			if(!$cols[0]){
				warn "Warning: CLASSVAR name missing in meta data of $datasetType\n";
				next;
			}
			if(!$cols[1] || !$cols[2]){
				warn "Warning: CLASSVAR class labels for '$cols[0]' missing in meta data of $datasetType\n";
				next;
			}
			if($cols[1] eq $NULL_CLASS || $cols[2] eq $NULL_CLASS){
				die "Error: CLASSVAR class label equals NULL CLASS in $datasetType\n";
			}
			my $classVarName = uc($cols[0]);
			my $class1 = uc($cols[1]);
			my $class2 = uc($cols[2]);
			$classes{$classVarName} = {$class1 => 1, $class2 => 1};
		}
		if($row =~ /^#CLASSMEM/){
			my @cols = split(/\s+/, $row);
			shift(@cols);
			if(!$cols[0]){
				warn "Warning: CLASSMEM name missing in meta data of $datasetType\n";