# Graphical Interface for Analogical Modeling

use Tk;
use Tk::Button;
use Tk::Checkbutton;
use Tk::Frame;
use Tk::LabEntry;
use Tk::LabFrame;
use Tk::Radiobutton;
use Tk::DialogBox;

$mw=MainWindow->new(-title=>'Analogical Modeling');
$Project_Options = $mw -> LabFrame ( -label=>'Project_Options', -relief=>'ridge', -labelside=>'acrosstop' ) -> pack(-fill=>'x', -side=>'top');
$Folder_Name = $Project_Options -> LabEntry ( -textvariable=>'sample', -label=>'Folder_Name', -background=>'White', -labelPack=>[-side=>'top',-anchor=>'n'], -state=>'normal', -justify=>'left', -relief=>'sunken' ) -> pack(-anchor=>'nw', -ipadx=>50, -side=>'left', -padx=>10);
$Delimiter = $Project_Options -> LabFrame ( -label=>'Delimiter', -relief=>'ridge', -labelside=>'acrosstop' ) -> pack(-side=>'right');
$Commas = $Delimiter -> Radiobutton ( -indicatoron=>1, -state=>'normal', -value=>'yes', -justify=>'left', -relief=>'flat', -text=>'Commas', -variable=>\$delimiter ) -> pack(-anchor=>'w');
$Spaces = $Delimiter -> Radiobutton ( -indicatoron=>1, -state=>'normal', -value=>'no', -justify=>'left', -relief=>'flat', -text=>'Spaces', -variable=>\$delimiter ) -> pack(-anchor=>'w');
$Buttons = $mw -> Frame ( -borderwidth=>2, -relief=>'groove' ) -> pack(-fill=>'x', -side=>'bottom');
$Run = $Buttons -> Button ( -command=>\&my_run, -state=>'normal', -relief=>'raised', -text=>'Run' ) -> pack(-pady=>10, -side=>'left', -padx=>80);
$Exit = $Buttons -> Button ( -command, sub{exit()}, -state, normal, -relief, raised, -text, Exit ) -> pack(-pady=>10, -side=>'left', -padx=>80);
$Output_Options = $mw -> LabFrame ( -label=>'Output_Options', -relief=>'ridge', -labelside=>'acrosstop' ) -> pack(-fill=>'y', -side=>'left');
$Squared = $Output_Options -> Radiobutton ( -indicatoron=>1, -state=>'normal', -value=>'no', -justify=>'left', -relief=>'flat', -text=>'Squared', -variable=>\$linear ) -> pack(-anchor=>'w');
$Linear = $Output_Options -> Radiobutton ( -indicatoron=>1, -state=>'normal', -value=>'yes', -justify=>'left', -relief=>'flat', -text=>'Linear', -variable=>\$linear ) -> pack(-anchor=>'w');
$given = 'exclude';
$nulls = 'exclude';
$skipset = 'yes';
$gangs = 'no';
$amode = 'off';
$Include_Given = $Output_Options -> Checkbutton ( -indicatoron=>1, -variable=>\$given, -offvalue=>'exclude', -onvalue=>'include', -state=>'normal', -justify=>'left', -relief=>'flat', -text=>'Include_Given' ) -> pack(-anchor=>'w');
$Include_Nulls = $Output_Options -> Checkbutton ( -indicatoron=>1, -variable=>\$nulls, -offvalue=>'exclude', -onvalue=>'include', -state=>'normal', -justify=>'left', -relief=>'flat', -text=>'Include_Nulls' ) -> pack(-anchor=>'w');
$Output_AM_Set = $Output_Options -> Checkbutton ( -indicatoron=>1, -variable=>\$skipset, -offvalue=>'yes', -onvalue=>'no', -state=>'normal', -justify=>'left', -relief=>'flat', -text=>'Output_AM_Set' ) -> pack(-anchor=>'w');
$Output_Gangs = $Output_Options -> Checkbutton ( -indicatoron=>1, -variable=>\$gangs, -offvalue=>'no', -onvalue=>'yes', -state=>'normal', -justify=>'left', -relief=>'flat', -text=>'Output_Gangs' ) -> pack(-anchor=>'w');
$Repeat_Options = $mw -> LabFrame ( -label=>'Repeat_Options', -relief=>'ridge', -labelside=>'acrosstop' ) -> pack(-fill=>'y', -side=>'left');
$Probability = $Repeat_Options -> LabEntry ( -label=>'Probability', -background=>'White', -labelPack=>[-side=>'top',-anchor=>'n'], -state=>'normal', -justify=>'left', -relief=>'sunken', -textvariable=>1 ) -> pack(-padx=>5);
$Repeat = $Repeat_Options -> LabEntry ( -label=>'Repeat', -background=>'White', -labelPack=>[-side=>'top',-anchor=>'n'], -state=>'normal', -justify=>'left', -relief=>'sunken', -textvariable=>1 ) -> pack();
$Hook_Options = $mw -> LabFrame ( -label=>'Hook_Options', -relief=>'ridge', -labelside=>'acrosstop' ) -> pack(-fill=>'y', -side=>'left');
$Enable = $Hook_Options -> Checkbutton ( -command=>\&my_setmode, -offvalue=>'off', -indicatoron=>1, -state=>'normal', -justify=>'left', -relief=>'flat', -text=>'Enable', -variable=>\$amode, -onvalue=>'on' ) -> pack(-anchor=>'w');
$Hook = $Hook_Options -> LabEntry ( -label=>'Hook', -background=>'White', -textvariable=>0, -labelPack=>[-side=>'top',-anchor=>'n'], -state=>'disabled', -justify=>'left', -relief=>'sunken' ) -> pack(-padx=>5);

MainLoop;

sub my_setmode{
	if ($amode eq 'on'){
		$Hook->configure(-state, normal);
	}
	if ($amode eq 'off'){
		$Hook->configure(-state, disabled);
	}
}

sub my_run{

$prob = $Probability->cget(-textvariable);
$rpt = $Repeat->cget(-textvariable);
$fname = $Folder_Name->cget(-textvariable);

if ($amode eq 'on'){
	$dcap = $Hook->cget(-textvariable);
	$setthresh = sub { $datacap = $dcap; };
};

use AM::Parallel;

$p = AM::Parallel->new($fname, -commas => $delimiter, -given => $given, -linear => $linear, -nulls => $nulls, -probability => $prob, -repeat => $rpt, -skipset => $skipset, -gangs => $gangs);

$count = 0;
$countsub = sub {
    ++$count if $sum[$curTestOutcome] eq $pointermax;
};

  $begin = sub {
    @confusion = ();
  };
  $endrepeat = sub {
    if (!$pointertotal) {
      ++$confusion[$curTestOutcome][0];
      return;
    }
    if ($sum[$curTestOutcome] eq $pointermax) {
      ++$confusion[$curTestOutcome][$curTestOutcome];
      return;
    }
    my @winners = ();
    my $i;
    for ($i = 1; $i < @outcomelist; ++$i) {
      push @winners, $i if $sum[$i] == $pointermax;
    }
    my $numwinners = scalar @winners;
    foreach (@winners) {
      $confusion[$curTestOutcome][$_] += 1 / $numwinners;
    }
  };
  $end = sub {
    my($i,$j);
    for ($i = 1; $i < @outcomelist; ++$i) {
      my $total = 0;
      foreach (@{$confusion[$i]}) {
        $total += $_;
      }
      next unless $total;
      printf "Test items with outcome $oformat were predicted as follows:\n",
        $outcomelist[$i];
      for ($j = 1; $j < @outcomelist; ++$j) {
        my $t;
        next unless ($t = $confusion[$i][$j]);
        printf "%7.3f%% $oformat  (%i/%i)\n", 100 * $t / $total, $outcomelist[$j], $t, $total;
      }
      if ($t = $confusion[$i][0]) {
        printf "%7.3f%% could not be predicted (%i/%i)\n", 100 * $t / $total, $t, $total;
      }
      print "\n\n";
    }
    print "Number of correct predictions: $count\n";
  };
  
	if ($amode eq 'off'){
		$p->(-beginhook => $begin, 
			-endtesthook => $countsub, -endrepeathook => $endrepeat,
			-endhook => $end);
	}
	if ($amode eq 'on'){
		$p->(-beginhook => $begin, 
			-endtesthook => $countsub, -endrepeathook => $endrepeat,
			-endhook => $end, -beginrepeathook => $setthresh);
	}
	
my $msgbox = $mw->DialogBox;
$Finished = $msgbox -> Label ( -justify=>'left', -text=>'Finished!', -relief=>'flat' ) -> pack(-pady=>5, -padx=>30);
$msgbox->Show;
}