#!usr/bin/perl
open (IN, "$ARGV[0]" || die "could not open input");
open (OUT, ">R-sq_$ARGV[0]" || die "could not open output");
while (<IN>){ chomp $_;	push (@a, $_);}
$y = 0;
for $n (0..$#a){ 
	@{'line'.$y} = split(/\t/,$a[$n]);
	$y++ unless $n == $#a;	
}
@pair = ();
for $n (1..$#line0){
	for $p (1..$#line0){
		push (@pair, $line0[$n]."\t".$line0[$p]);
	}
}
$d = $y * 2;
$a = $b = $ab = 0; $c = 1; @ab = @ba = @Pa = @Pnota = @Pb = @Pnotb = @Pab = @{'sub_pair'.$c} = ();
for $n (0..$#pair){
	@{'sub_pair'.$c} = split(/\t/,$pair[$n]);
	$c++ unless $n == $#pair;
}
for $f (1..$c){
	for $n (0..1){
		for $z(1..$#line0){
			if (${'sub_pair'.$f}[$n] eq $line0[$z]){
				if ($n == 0){
					for $v(1..$y){
						push (@ab, ${'line'.$v}[$z]);
						if (${'line'.$v}[$z] == 2){ $a += 2;}
						elsif (${'line'.$v}[$z] == 1){ $a++;}
					}
					$Pa = $a/$d; $Pnota = 1 - $Pa;
					push (@Pa, $Pa); push (@Pnota, $Pnota);
					$a = 0;
				}
				if ($n == 1){
					for $v(1..$y){
						push (@ba, ${'line'.$v}[$z]);
						if (${'line'.$v}[$z] == 2){ $b += 2;}
						elsif (${'line'.$v}[$z] == 1){ $b++;}
					}
					$Pb = $b/$d; $Pnotb = 1 - $Pb;
					push (@Pb, $Pb); push (@Pnotb, $Pnotb);	
					$b = 0;
				}
			}
		}
	}
	for $x (0..$#ab){
		if ($ab[$x] eq 2 && $ba[$x] eq 2){$ab += 2;}
		elsif ($ab[$x] eq 2 && $ba[$x] eq 1){$ab++;}
		elsif ($ab[$x] eq 1 && $ba[$x] eq 2){$ab++;}
		elsif ($ab[$x] eq 1 && $ba[$x] eq 1){$ab++;}
	}
	$Pab = $ab/$d;
	push (@Pab, $Pab);
	$ab = 0; @ab = @ba = ();			
}
@Rsq = ();
for $n (0..$#Pa){
	$R = (($Pab[$n] - ($Pa[$n]*$Pb[$n]))**2)/($Pa[$n]*$Pnota[$n]*$Pb[$n]*$Pnotb[$n]);
	$Rsq = sprintf ("%.4f", $R);
	push (@Rsq, $Rsq);
}
print OUT "CORR\t";
for $z (1..$#line0){
	print OUT $line0[$z],"\t";
}
print OUT "\n";
$start = 0;
for $z (1..$#line0){
	print OUT $line0[$z],"\t";
	$l = $#line0 - 1;
	$end = $start + $l;
	for $x ($start..$end){
		print OUT $Rsq[$x],"\t";
	}
	$start += $#line0;
	print OUT "\n";
}