#!/usr/bin/perl -w

use Tk;

$mw = MainWindow->new;
$mw->Label(-text=>'Moving Average Interpolation Calculator by Charlie Kim',
	   )->pack();

# Input #
$inputfr = $mw->Frame(-relief=>'groove',
		      -label=>'Input File in tab-delimited format',
		      -borderwidth=>2,
		      )->pack(-side=>'top',
			      -anchor=>'nw',
			      -fill=>'both',
			      );
#$inputfr->Label(-text=>'File must be tab-delimited',
#		)->pack();
$single_e = $inputfr->Entry(-state=>'normal',
			    -textvariable=> \$singlefile,
			    -width=>30,
			    )->pack(-side=>'left',
				    -pady=>3,
				    );
$inputfr->Button(-text=>'Browse',
		 -command=> \&selectsinglefile,
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'left',
			 );

$numberfr = $mw->Frame(-relief=>'groove',
		       -borderwidth=>2,
		      )->pack(-side=>'top',
			      -anchor=>'nw',
			      -fill=>'both',
			      );
$numberfr->Label(-text=>'Number of animals per group',
		 )->pack();
$n = 5;

$numberfr->Scale(-from=>1,
		 -to=>50,
		 -variable=> \$n,
		 -orient=>'horizontal',
		 -length=>200,
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 );

#$numberfr->Entry(-state=>'normal',
#		 -textvariable=> \$n,
#		 -width=>30,
#		 )->pack(-side=>'left',
#			 -pady=>3,
#			 );



# Run #
$mw->Button(-text=>"Run MAI",
	    -command=> [ \&main, \$mw],
	    -state=> 'normal',
	    )->pack();

$mw->Button(-text=>"Exit",
	    -command=> sub { exit },
	    )->pack();

MainLoop;


sub selectsinglefile {
    my $file = $mw->getOpenFile();
    if (defined $file and $file ne '') {
	$single_e->delete(0, 'end');
	$single_e->insert(0, $file);
	$single_e->xview('end');
    }
}

sub errormsg {
    my $msg = shift;
    my $errorwin = $mw->Toplevel();
    $errorwin->Label(-text=> $msg,
		     )->pack();
    $errorwin->Button(-text=>'Close',
		      -command=> sub { $errorwin->destroy },
		      )->pack();
    $errorwin->waitWindow();
}

sub main {
    my $mwref = shift;
    my $mw = $$mwref;
    my @survival = ();
    my @dose = ();
    my @header = ();

    &readdata($singlefile, \@survival, \@header, \@dose);
    shift @header;
    $outfile = $mw->getSaveFile;
    open(OUTFILE,">$outfile") or die "Can't open outfile $outfile\n";
    print OUTFILE "Dataset\tComments\tdf\tf\tg\tlog(ld50)\t95\%CI\tld50\tCIlow\tCIhigh\n";
    for (my $c = 0; $c <= $#survival; $c++) {
	my $ref = $survival[$c];
	my @maistat = &maincalc( \@dose, $ref );

	print OUTFILE "$header[$c]";
	foreach (@maistat) {
	    print OUTFILE "\t$_";
	}
	print OUTFILE "\n";
    }
    close OUTFILE;
    $mw->bell;
    $mw->messageBox(-title => 'Program Finished',
		    -message => 'Processing complete',
		    -type => 'OK');
}

sub readdata {
    my $file = shift;
    my $survivalref = shift;
    my $headerref = shift;
    my $doseref = shift;

    open(INFILE,$file) or die "Couldn't open inile\n";
    chomp($headers=<INFILE>);
    @{$headerref} = split(/\t/,$headers);

    my $d = 0;
    while(<INFILE>) {
	chomp;
	next if !$_;
	@line = split(/\t/);
	push @{$doseref}, $line[0];

	foreach (my $c = 0; $c <=$#line-1; $c++) {
	    $survivalref->[$c][$d] = $line[$c+1];
	}
	$d++;

    }
    close INFILE;

}

sub maincalc {
    my @dose = @{$_[0]};
    my @deaths = @{$_[1]};

    my @calcdata = ();
    $calcdata[0] = "None";

    if ($dose[0] > $dose[$#dose]) {
	@dose = reverse(@dose);
	@deaths = reverse(@deaths);
    }

    for (my $c = 0; $c <= $#deaths; $c++) {
	$deaths[$c] = $n - $deaths[$c];
    }

    if ($deaths[$#deaths] - $deaths[0] == 0) {
	return "Not Calculated: no difference in deaths";
    }

    my $df = 10 ** (0.4343 * log( $dose[$#dose]/$dose[0] ) / $#dose);
    
    my $f = ( $n * $#dose) / 2.0;
    for (my $c = 0; $c <= $#dose - 1; $c++) {
	$f -= $deaths[$c];
    }
    $f /= $deaths[$#deaths] - $deaths[0];

    if ($f < 0 || $f > 1) {
	$calcdata[0] = "Warning: f value not between 0 and 1";
    }
    
    my $g = ( (1 - $f)**2 ) * $deaths[0] * ($n - $deaths[0] );
    for (my $c = 1; $c <= $#dose; $c++) {
	$g += $deaths[$c] * ($n-$deaths[$c]);
    }
    $g = sqrt( $g / ($n-1) / ( ($deaths[$#dose] - $deaths[0]))**2);
    
    my $ld50 = 0.4343 * log($dose[0]) + 0.4343 * log($df) * ($#dose - 1)/2 + 0.4343 * log($df) * $f;
    
    my $ci_int = 2.0 * $g * 0.4343 * log($df);
    my $ldlow = $ld50 - $ci_int;
    my $ldhigh = $ld50 + $ci_int;
    my $linld50 = 10 ** $ld50;
    my $linlow = 10 ** $ldlow;
    my $linhigh = 10 ** $ldhigh;
    push @calcdata, ($df,$f,$g,$ld50,$ci_int,$linld50,$linlow,$linhigh);

    return @calcdata;
    
}