roc_ui.pl

A Perl module implementing receiver-operator-characteristic (ROC) curves with nonparametric confid

      print CURVES "Modeltype: $$model_type, 2-sided confidence interval: ",$$conf/100,"\n";
      print CURVES "Threshold: $$$var_grp[$gmax][0] \n";
      print CURVES "$text1\n";
      print CURVES "#######\n"; 
      print CURVES "Empirical ROC curve (x,y):\n";
      for($i=0;$i<$#ss2+1;$i++)	  # step thru (x,y)-pairs
	{
	  print CURVES (1-$ss2[$i][2]),"  ",$ss2[$i][1],"\n";
	}
      print CURVES "#######\n";
      print CURVES "Estimated ROC curve (x,y):\n";
      for(my $i=0;$i<@{$ROC[0]};$i++) # step thru (x,y)-pairs
	{
	  print CURVES $ROC[1][$i][0],"  ",$ROC[1][$i][1],"\n";
	}
      print CURVES "#######\n";
      print CURVES "Upper bound to estimated ROC curve (x,y):\n";
      for(my $i=0;$i<@{$ROC[0]};$i++) # step thru (x,y)-pairs
	{
	  print CURVES $ROC[0][$i][0],"  ",$ROC[0][$i][1],"\n";
	}
      print CURVES "#######\n"; 
      print CURVES "Lower bound to estimated ROC curve (x,y):\n";
      for(my $i=0;$i<@{$ROC[0]};$i++) # step thru (x,y)-pairs
	{
	  print CURVES $ROC[2][$i][0],"  ",$ROC[2][$i][1],"\n";
	}
      close(CURVES);
    }
                   
} # end draw_roc


sub initialize_messages{
  
  my $MW=shift;
  # Create all application Dialog objects.
  $DIALOG_LOAD_ERROR=$MW->Dialog(-title   => 'ERRROR',-text    => 
				 "The data has NOT been loaded or is NOT in the right format! 
The datafile has to have the following structure with one
sample per row: \n    <value> <class:0/1>",
				 -bitmap  => 'info',-wraplength => '3i',
				 -buttons => ['Dismiss'],
				 #-font => 'Arialbold'
				 );
  $DIALOG_ABOUT = $MW->Dialog(
			      -title   => 'About',
			      -text    => 
			      "ROC with confidence $VERSION \n\nApril 26. 2007\n\n
This program calculates receiver-operator characteristic  
curves with nonparametric confidence bounds from data 
separated into two groups.\n
Author: Hans A. Kestler, h.kestler\@ieee.org
                         hans.kestler\@uni-ulm.de
Copyright (c) 1998-2007 by Hans Kestler. All rights reserved. 
This program is free software; it may be redistributed and/or 
modified under the same terms as Perl itself.",
				-bitmap  => 'info',-wraplength => '6i',
				-buttons => ['Dismiss'],
				);
    #$DIALOG_ABOUT->configure(-wraplength => '6i');
    $DIALOG_USAGE = $MW->Dialog(
				-title   => 'Usage',
				-buttons => ['Dismiss'],
				);
    $DIALOG_USAGE->Subwidget('message')->configure(
						   -wraplength => '5i',
	 -text =>
"This program calculates and displays ROC curves
with confidence bounds. These bounds are
calculated nonparametrically.\n
The inputfile from which the ROC curve is
determined may be loaded with the LOAD button
in the FILE menu. It has to have the following 
structure with one sample per row: 
        <value> <class:0/1>.\n
The model assumption may be selected below the
drawing area. The confidence limits are set
with the scales. The curve won't be redrawn
after changing this interval. Either the model
has to be reselected or the BOUNDS ON/OFF 
button in the OPTIONS menu has to be toggled
to redraw the curve.\n
The ROC curve may be saved or printed by selecting
the <Print/Save as Postscript> button below the
canvas. If the entry field just above this
button is set to <lpr> the curve will be sent to
the printer otherwise it will saved in the file
specified (so don't use a filename with the
string lpr at the begining).\n
The <Options> menu gives some restricted 
possibilities of changing the appearance of the
graph. The <Optimium> is calculated by maximizing
simultaneously the sensitivity and specificity.
The performance values displayed above the canvas
give the optimal dicriminative ability of the
threshold value maximizing sensitivity and
specificity. If the model is grp0 < grp1 the 
threshold value belongs to grp0, i.e.
grp1 if value > threshold.");


} # end initialize_messages


sub draw_grid{
  # Draws a grid inside the canvas widget
  #
  # The available space is evenly divided into 10x10
  # rectangels.
  # Arguments: * handle of the canvas widget
  #            * (0,0)- and (1,1)-points in pixles
  #              of the drawing area (this is the complete drawing area)
  #              It is assumed that y-coordinates increase from top
  #              to bottom of the widget, the x-coord. increase as expected
  #              from left to right.
  
  my ($c,$xzero,$yzero,$xone,$yone)=@{shift()};
  
  for(my $i=0,my $inc=($xone-$xzero)/10;$i<=10;$i++){
    $c->createLine($xzero+$i*$inc,$yzero+4,
		   $xzero+$i*$inc,$yone,-width=>1,-tags=>['grid']);
  }
  for(my $i=0,my $inc=($yone-$yzero)/10;$i<=10;$i++){
    $c->createLine($xzero-4,$yzero+$i*$inc,
		   $xone,$yzero+$i*$inc,-width=>1,-tags=>['grid']);
  }
}				# end draw_grid


sub draw_small_ticks{
  # Draws small ticks. 
  #
  # Draws 100 small ticks on the x- and y- axis.
  # Arguments: * handle of the canvas widget
  #            * (0,0)- and (1,1)-points in pixles
  #              of the drawing area (this is the complete drawing area)
  #              It is assumed that y-coordinates increase from top
  #              to bottom of the widget, the x-coord. increase as expected
  #              from left to right.
  
  my ($c,$xzero,$yzero,$xone,$yone)=@{shift()};
  
  for(my $i=0,my $inc=($xone-$xzero)/100;$i<=100;$i++){
    $c->createLine($xzero+$i*$inc,$yzero+3,
		   $xzero+$i*$inc,$yzero,-width=>.5);
  }
  for(my $i=0,my $inc=($yone-$yzero)/100;$i<=100;$i++){
    $c->createLine($xzero-3,$yzero+$i*$inc,
		   $xzero,$yzero+$i*$inc,-width=>.5);
  }
}				# end draw_small_ticks


sub draw_numbers{
  # Draws the numbers {0, 0.1,..., 0.9, 1.0} the x- and y-axis. 
  #
  # Arguments: * handle of the canvas widget
  #            * (0,0)- and (1,1)-points in pixles
  #              of the drawing area (this is the complete drawing area)
  #              It is assumed that y-coordinates increase from top
  #              to bottom of the widget, the x-coord. increase as expected
  #              from left to right.
  
  my ($c,$xzero,$yzero,$xone,$yone)=@{shift()};
  
  for(my $i=0,my $inc=($xone-$xzero)/10;$i<=10;$i+=2){
    $c->create('text',$xzero+$i*$inc,$yzero+4+10,
	       -text=>$i/10);
  }
  for(my $i=0,my $inc=($yone-$yzero)/10;$i<=10;$i+=2){
    $c->create('text',$xzero-4-10,$yzero+$i*$inc,
	       -text=>$i/10);
  }
}				# end draw_numbers


sub draw_diagonal{
  # Draws a diagonal from (0,0) to (1,1).
  #
  # Arguments: * handle of the canvas widget
  #            * (0,0)- and (1,1)-points in pixles
  #              of the drawing area (this is the complete drawing area)
  #              It is assumed that y-coordinates increase from top
  #              to bottom of the widget, the x-coord. increase as expected
  #              from left to right.
  
  my ($c,$xzero,$yzero,$xone,$yone)=@{shift()};
  
  $c->createLine($xzero,$yzero,$xone,$yone,-width=>1, -tags=>['diag']);
  
}				# end draw_diagonal





my @var_grp=();
my $var_grp_ref=\@var_grp;
my $MW = new MainWindow;
$MW->title("ROC with confidence");
my $MBF=$MW->Frame(-relief=>'raised',-borderwidth=>1)->pack(-fill=>'x');


my ($xsize,$ysize)=(600,580);
my $area=500;			# actually the length of the quadratic area

# derived values
my ($xzero,$yzero)=(($xsize-$area)/2,$ysize-($ysize-$area)/2);
my ($xone,$yone)=($xsize-($xsize-$area)/2,($ysize-$area)/2);
my @points=($xzero,$yzero,$xone,$yone);
my $model_type ='grp0 < grp1'; 
my $conf=95;
$main::name=""; 


my $c=$MW->Canvas(-width=>$xsize,-height=>$ysize)->pack;
$c->create('text',($xone-$xzero)/2+$xzero,$yzero+4+10+12,-text=>"1-SPECIFICITY");
#my (@i)=qw/S e n s i t i v i t y/;
for(my $i=0,my (@i)=qw/S E N S I T I V I T Y/;$i<@i;$i++){
    $c->create('text',$xzero-36, ($yone-$yzero)/2+$yzero+$i*14-50,-text=>"$i[$i]");}

initialize_messages($MW);
draw_grid([$c,@points]);
draw_numbers([$c,@points]);
draw_small_ticks([$c,@points]);
draw_diagonal([$c,@points]);



###### File Menu Button ######
make_menubutton($MBF,'File',0,'left',[
        ['Load',[\&fileSelector,[$MW,$c,@points,\$model_type,\$conf,\$var_grp_ref]],0],
        ['Quit',\&exit,0]     ]);
##############################

###### Options Menu Button ######
my $mb_o=$MBF->Menubutton(-text=>'Options',-underline=>0)->pack(-side=>'left');
($main::state_b,$main::state_g,$main::state_d,$main::state_o,$main::state_p,$main::state_r,
                                             $main::state_v,$main::state_s)=(1,1,1,1,1,1,1,0);
$mb_o->checkbutton(
         -label=>'Bounds on/off',
         -variable=>\$main::state_b,
         -command=>sub{if(!$main::state_b){$c->delete('bounds')}
                       else{draw_roc([$c,@points,\$model_type,\$conf,\$var_grp_ref]);}}
        );    
$mb_o->checkbutton(
         -label=>'Grid on/off',
         -variable=>\$main::state_g,
         -command=>sub{if(!$main::state_g){$c->delete('grid')}
                       #else{draw_grid([$c,@points]);}}
                       else{draw_grid([$c,@points]);
                            draw_roc([$c,@points,\$model_type,\$conf,\$var_grp_ref]);}}
        );
$mb_o->checkbutton(
         -label=>'Diagonal on/off',
         -variable=>\$main::state_d,
         -command=>sub{if(!$main::state_d){$c->delete('diag')}
                       else{draw_diagonal([$c,@points]);}}
        );
$mb_o->checkbutton(
         -label=>'Optimum on/off',
         -variable=>\$main::state_o,
         -command=>sub{if(!$main::state_o){$c->delete('opt')}
                       else{draw_roc([$c,@points,\$model_type,\$conf,\$var_grp_ref]);}} 
        );
$mb_o->checkbutton(
         -label=>'Estimated ROC on/off',
         -variable=>\$main::state_p,
         -command=>sub{if(!$main::state_p){$c->delete('plot')}
                       else{draw_roc([$c,@points,\$model_type,\$conf,\$var_grp_ref]);}} 
        );
$mb_o->checkbutton(
         -label=>'Empirical ROC on/off',
         -variable=>\$main::state_r,
         -command=>sub{if(!$main::state_r){$c->delete('realroc')}
                       else{draw_roc([$c,@points,\$model_type,\$conf,\$var_grp_ref]);}} 
        );
$mb_o->checkbutton(
         -label=>'Values on/off',
         -variable=>\$main::state_v,
         -command=>sub{if(!$main::state_v){$c->delete('values')}
                       else{draw_roc([$c,@points,\$model_type,\$conf,\$var_grp_ref]);}} 
        );                                
$mb_o->checkbutton(
         -label=>"Save curve values to file (suffix \".txt\" added) off/on",
         -variable=>\$main::state_s,
         -command=>sub{if($main::state_s)
                           {draw_roc([$c,@points,\$model_type,\$conf,\$var_grp_ref]);}} 
        );
# $save_cur->configure(label=>'Save curves values to file: $main::name.dat on/off');
##############################

###### Help Menu Button ######
make_menubutton($MBF, 'Help', 0, 'right',
		    [
		     ['About', [$DIALOG_ABOUT => 'Show'], 0],
		     ['',      undef,                     0],
		     ['Usage', [$DIALOG_USAGE => 'Show'], 0],
		    ],
		   );
##############################



# create border of curve
$c->create('rectangle', @points , -width=>2);     # line width of 2



#### lower part: below drawing area (canvas)
my $controls=$MW->Frame(qw/ -relief ridge/)->pack(-fill=>'x');
$controls->gridColumnconfigure(1,-weight=>1);
my $left=$controls->Frame(qw/-bd 5 -relief ridge/)->grid(qw/-row 0 -column 0 -sticky nsw/);
my $right=$controls->Frame(qw/-bd 5 -relief ridge/)->grid(qw/-row 0 -column 1 -sticky ew/);


######## Print/Save as PostScript #######
my %pinfo=('prcmd','lpr');
my $w_prcmd = $left->Entry(
              -textvariable => \$pinfo{'prcmd'},);
$MW->Advertise('entry' => $w_prcmd);
$w_prcmd->grid(qw/-row 0 -column 0  -sticky ew/);

my $w_print = $left->Button(
        -text         => 'Print/Save as PostScript',
        -command      => [\&roc_save, $c, \%pinfo],);
$MW->Advertise('PostScript_button' => $w_print);
$w_print->grid(qw/-row 1 -column 0  -sticky w /);
$w_prcmd->bind('<Return>' => [$w_print => 'invoke']);
##########################################

######## Delete ROC curves ###############
my $del_roc=$left->Button(-text=>'Delete ROC curve!',
                             -command=>sub{$c->delete('plot');
                                           $c->delete('opt');
                                           $c->delete('bounds');
                                           $c->delete('realroc');
                                           $c->delete('values')},                       
                             -relief=>'raised')
                             ->grid(qw/-row 2 -column 0 -sticky ew/);

##########################################



######## Confidence Interval #########
my $conf_scale=$right->Scale('-orient'=> 'horizontal',
                           '-from'=> 0, '-to'=> 100, '-tickinterval'=> 0, '-width'=> 15, 
                           '-length'=> 340,
                           '-label'=> "2-sided Confidence Interval (%)",
                          -variable=>\$conf,
           #-command=> [\&draw_roc, [$c, @points,\$model_type,\$conf,\$var_grp_ref]], 
           )->grid(qw/-row 0 -column 0 -columnspan 2  -sticky ew/);
######################################


######## Model option button #########
my $model_button=$right->Menubutton(-text=>'Model:   ',
    -relief=>'raised' )->grid(qw/-row 1 -column 0  -sticky ew/);
my $model=$right->Optionmenu(-variable => \$model_type,
                     -options => ['grp0 < grp1', 'grp0 > grp1'], 
                   #   -options=>['GGGGGGG', 'CCCCCC'],
                   #-command=>sub{print "$model_type \n";},
                   # -command=>sub{print $model_type," \n";},
           #-command=> [\&draw_roc, [$c, @points,\$model_type,0.95,@var_grp]],
         -command=> [\&draw_roc, [$c, @points,\$model_type,\$conf,\$var_grp_ref]],
         -relief=>'raised');
$model->grid(qw/-row 1 -column 1 -sticky ew/);                     
#######################################



MainLoop;