Skip to content

Commit 70f4542

Browse files
added verbosity statements to more detailed output in BLANC function
1 parent ffaec5e commit 70f4542

File tree

1 file changed

+105
-96
lines changed

1 file changed

+105
-96
lines changed

lib/CorScorer.pm

Lines changed: 105 additions & 96 deletions
Original file line numberDiff line numberDiff line change
@@ -25,9 +25,10 @@ use Algorithm::Munkres;
2525
use Data::Dumper;
2626
#use Algorithm::Combinatorics qw(combinations);
2727
use Math::Combinatorics;
28+
use Cwd;
2829

29-
our $VERSION = '7.0';
30-
print "version: ".$VERSION."\n";
30+
our $VERSION = '8.0';
31+
print "version: ".$VERSION." ".Cwd::realpath(__FILE__)."\n";
3132

3233
#
3334
# 7.0 Removed code to compute *_cs metrics
@@ -871,32 +872,40 @@ sub BLANC_Internal
871872
my ($ga, $gr, $ba, $br) = (0, 0, 0, 0);
872873
my $key_coreference_links = {};
873874
my $key_non_coreference_links = {};
874-
875875
my $response_coreference_links = {};
876876
my $response_non_coreference_links = {};
877877

878878

879-
print "list containing list of chains in key:\n";
880-
print Dumper $keys;
879+
print "list containing list of chains in key:\n" if ($VERBOSE > 2);
880+
print Dumper $keys if ($VERBOSE > 2);
881881

882-
print "each key chain printed individually:\n";
883-
foreach my $z (@$keys)
884-
{
885-
print Dumper $z;
886-
}
882+
print "each key chain printed individually:\n" if ($VERBOSE > 2);
883+
884+
if ( $VERBOSE > 2 )
885+
{
886+
foreach my $z (@$keys)
887+
{
888+
print Dumper $z;
889+
}
890+
}
891+
892+
print "list containing list of chains in response:\n" if ($VERBOSE > 2);
893+
print Dumper $response if ($VERBOSE > 2);
887894

888-
print "list containing list of chains in response:\n";
889-
print Dumper $response;
895+
print "each response chain printed individually:\n" if ($VERBOSE > 2);
890896

891-
print "each response chain printed individually:\n";
892-
foreach my $z (@$response)
893-
{
894-
print Dumper $z;
895-
}
896-
print "---------------------------------------------------------------------------------" . "\n";
897+
if ($VERBOSE > 2)
898+
{
899+
foreach my $z (@$response)
900+
{
901+
print Dumper $z;
902+
}
903+
}
904+
905+
print "---------------------------------------------------------------------------------" . "\n" if ($VERBOSE > 2);
897906

898907

899-
print "combinations of links for each chain in the key:\n";
908+
print "combinations of links for each chain in the key:\n" if ($VERBOSE > 2);
900909
for my $kkk (@$keys)
901910
{
902911
my $ccombinat = Math::Combinatorics->new(count => 2,
@@ -905,20 +914,20 @@ sub BLANC_Internal
905914

906915
while(my @zcombo = $ccombinat->next_combination)
907916
{
908-
print Dumper [@zcombo];
917+
print Dumper [@zcombo] if ($VERBOSE > 2);
909918
my @zzcombo = sort {$a <=> $b} @zcombo;
910919

911920
$key_coreference_links->{$zzcombo[0] . "-" . $zzcombo[1]} = 1;
912921
}
913922

914-
print "................................................................................\n";
923+
print "................................................................................\n" if ($VERBOSE > 2);
915924
}
916925

917-
print Dumper $key_coreference_links;
918-
print "********************************************************************************\n";
926+
print Dumper $key_coreference_links if ($VERBOSE > 2);
927+
print "********************************************************************************\n" if ($VERBOSE > 2);
919928

920-
print "---------------------------------------------------------------------------------" . "\n";
921-
print "combinations of links for each chain in the response:\n";
929+
print "---------------------------------------------------------------------------------" . "\n" if ($VERBOSE > 2);
930+
print "combinations of links for each chain in the response:\n" if ($VERBOSE > 2);
922931
for my $rrr (@$response)
923932
{
924933
my $ccombinat = Math::Combinatorics->new(count => 2,
@@ -927,20 +936,20 @@ sub BLANC_Internal
927936

928937
while(my @zcombo = $ccombinat->next_combination)
929938
{
930-
print Dumper [@zcombo];
939+
print Dumper [@zcombo] if ($VERBOSE > 2);
931940
my @zzcombo = sort {$a <=> $b} @zcombo;
932941

933942
$response_coreference_links->{$zzcombo[0] . "-" . $zzcombo[1]} = 1;
934943
}
935944

936-
print "................................................................................\n";
945+
print "................................................................................\n" if ($VERBOSE > 2);
937946
}
938947

939-
print Dumper $response_coreference_links;
940-
print "********************************************************************************\n";
948+
print Dumper $response_coreference_links if ($VERBOSE > 2);
949+
print "********************************************************************************\n" if ($VERBOSE > 2);
941950

942951
my $number_chains_in_key = @$keys;
943-
print "number chains in key: " . $number_chains_in_key . "\n";
952+
print "number chains in key: " . $number_chains_in_key . "\n" if ($VERBOSE > 2);
944953

945954
my @s = (0..$number_chains_in_key - 1);
946955
my $ss = join(' ', @s);
@@ -950,8 +959,8 @@ sub BLANC_Internal
950959
data => [@n],
951960
);
952961

953-
print "combinations of 2 from: ".join(" ",@n)."\n";
954-
print "------------------------".("--" x scalar(@n))."\n";
962+
print "combinations of 2 from: ".join(" ",@n)."\n" if ($VERBOSE > 2);
963+
print "------------------------".("--" x scalar(@n))."\n" if ($VERBOSE > 2);
955964

956965
while(my @combo = $combinat->next_combination){
957966

@@ -962,32 +971,32 @@ sub BLANC_Internal
962971
}
963972

964973
my $lkcombo = @kcombo;
965-
print "length: " . $lkcombo . "\n";
966-
print "kcombo:\n";
967-
print "+++++\n";
968-
print Dumper [@kcombo];
974+
print "length: " . $lkcombo . "\n" if ($VERBOSE > 2);
975+
print "kcombo:\n" if ($VERBOSE > 2);
976+
print "+++++\n" if ($VERBOSE > 2);
977+
print Dumper [@kcombo] if ($VERBOSE > 2);
969978
my @kccar = cartesian($kcombo[0], $kcombo[1]);
970979

971980
foreach my $x (@kccar)
972981
{
973-
print "--->>>>>>>>>>>>\n";
974-
print Dumper $x;
982+
print "--->>>>>>>>>>>>\n" if ($VERBOSE > 2);
983+
print Dumper $x if ($VERBOSE > 2);
975984
my @y = sort {$a <=> $b} @$x;
976-
print Dumper [@y];
985+
print Dumper [@y] if ($VERBOSE > 2);
977986
$key_non_coreference_links->{@y[0] . "-" . @y[1]} = 1
978987
}
979988

980-
print Dumper $key_non_coreference_links;
981-
print "" . "\n";
989+
print Dumper $key_non_coreference_links if ($VERBOSE > 2);
990+
print "" . "\n" if ($VERBOSE > 2);
982991

983-
print ".....\n";
992+
print ".....\n" if ($VERBOSE > 2);
984993

985-
print "\n";
994+
print "\n" if ($VERBOSE > 2);
986995
}
987996

988-
print "\n";
997+
print "\n" if ($VERBOSE > 2);
989998
my $number_chains_in_response = @$response;
990-
print "number chains in response: " . $number_chains_in_response . "\n";
999+
print "number chains in response: " . $number_chains_in_response . "\n" if ($VERBOSE > 2);
9911000

9921001
my @s = (0..$number_chains_in_response - 1);
9931002
my $ss = join(' ', @s);
@@ -997,8 +1006,8 @@ sub BLANC_Internal
9971006
data => [@n],
9981007
);
9991008

1000-
print "combinations of 2 from: ".join(" ",@n)."\n";
1001-
print "------------------------".("--" x scalar(@n))."\n";
1009+
print "combinations of 2 from: ".join(" ",@n)."\n" if ($VERBOSE > 2);
1010+
print "------------------------".("--" x scalar(@n))."\n" if ($VERBOSE > 2);
10021011

10031012
while(my @combo = $combinat->next_combination){
10041013
my @kcombo = ();
@@ -1008,101 +1017,101 @@ sub BLANC_Internal
10081017
}
10091018

10101019
my $lkcombo = @kcombo;
1011-
print "length: " . $lkcombo . "\n";
1012-
print "kcombo:\n";
1013-
print "+++++\n";
1014-
print Dumper [@kcombo];
1020+
print "length: " . $lkcombo . "\n" if ($VERBOSE > 2);
1021+
print "kcombo:\n" if ($VERBOSE > 2);
1022+
print "+++++\n" if ($VERBOSE > 2);
1023+
print Dumper [@kcombo] if ($VERBOSE > 2);
10151024
my @kccar = cartesian($kcombo[0], $kcombo[1]);
10161025

10171026
foreach my $x (@kccar)
10181027
{
1019-
print "--->>>>>>>>>>>>\n";
1020-
print Dumper $x;
1028+
print "--->>>>>>>>>>>>\n" if ($VERBOSE > 2);
1029+
print Dumper $x if ($VERBOSE > 2);
10211030
my @y = sort {$a <=> $b} @$x;
1022-
print Dumper [@y];
1031+
print Dumper [@y] if ($VERBOSE > 2);
10231032
$response_non_coreference_links->{@y[0] . "-" . @y[1]} = 1
10241033
}
10251034

1026-
print Dumper $response_non_coreference_links;
1027-
print "" . "\n";
1035+
print Dumper $response_non_coreference_links if ($VERBOSE > 2);
1036+
print "" . "\n" if ($VERBOSE > 2);
10281037

1029-
print ".....\n";
1030-
print "\n";
1038+
print ".....\n" if ($VERBOSE > 2);
1039+
print "\n" if ($VERBOSE > 2);
10311040
}
10321041

1033-
print "\n";
1042+
print "\n" if ($VERBOSE > 2);
10341043

1035-
print "<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
1036-
print Dumper $key_coreference_links;
1037-
print Dumper $response_coreference_links;
1038-
print Dumper $key_non_coreference_links;
1039-
print Dumper $response_non_coreference_links;
1040-
print "<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
1044+
print "<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n" if ($VERBOSE > 2);
1045+
print Dumper $key_coreference_links if ($VERBOSE > 2);
1046+
print Dumper $response_coreference_links if ($VERBOSE > 2);
1047+
print Dumper $key_non_coreference_links if ($VERBOSE > 2);
1048+
print Dumper $response_non_coreference_links if ($VERBOSE > 2);
1049+
print "<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n" if ($VERBOSE > 2);
10411050

10421051
my @union_cl = my @isect_cl = ();
10431052
my %union_cl = my %isect_cl = ();
10441053

10451054
my @kcl = keys %$key_coreference_links;
10461055
my @rcl = keys %$response_coreference_links;
10471056

1048-
print Dumper @kcl;
1049-
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n";
1050-
print Dumper @rcl;
1051-
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n";
1057+
print Dumper @kcl if ($VERBOSE > 2);
1058+
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n" if ($VERBOSE > 2);
1059+
print Dumper @rcl if ($VERBOSE > 2);
1060+
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n" if ($VERBOSE > 2);
10521061

10531062
foreach my $e (@kcl, @rcl) { $union_cl{$e}++ && $isect_cl{$e}++}
10541063

10551064
@union_cl = keys %union_cl;
10561065
@isect_cl = keys %isect_cl;
10571066

1058-
print Dumper @isect_cl;
1059-
print "********************************************************************************\n";
1067+
print Dumper @isect_cl if ($VERBOSE > 2);
1068+
print "********************************************************************************\n" if ($VERBOSE > 2);
10601069

10611070
my @union_ncl = my @isect_ncl = ();
10621071
my %union_ncl = my %isect_ncl = ();
10631072

10641073
my @kncl = keys %$key_non_coreference_links;
10651074
my @rncl = keys %$response_non_coreference_links;
10661075

1067-
print Dumper @kncl;
1068-
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n";
1069-
print Dumper @rncl;
1070-
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n";
1076+
print Dumper @kncl if ($VERBOSE > 2);
1077+
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n" if ($VERBOSE > 2);
1078+
print Dumper @rncl if ($VERBOSE > 2);
1079+
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n" if ($VERBOSE > 2);
10711080

10721081
foreach my $e (@kncl, @rncl) { $union_ncl{$e}++ && $isect_ncl{$e}++}
10731082

10741083
@union_ncl = keys %union_ncl;
10751084
@isect_ncl = keys %isect_ncl;
10761085

1077-
print Dumper @isect_ncl;
1078-
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n";
1086+
print Dumper @isect_ncl if ($VERBOSE > 2);
1087+
print "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n" if ($VERBOSE > 2);
10791088

10801089
my $num_isect_cl = @isect_cl;
1081-
print " number of links in the intersection of key and response coreference links: " . $num_isect_cl . "\n";
1090+
print " number of links in the intersection of key and response coreference links: " . $num_isect_cl . "\n" if ($VERBOSE > 2);
10821091

10831092
my $num_isect_ncl = @isect_ncl;
1084-
print "number of links in the intersection of key and response non-coreference links: " . $num_isect_ncl . "\n";
1093+
print "number of links in the intersection of key and response non-coreference links: " . $num_isect_ncl . "\n" if ($VERBOSE > 2);
10851094

10861095
my $num_key_coreference_links = keys %$key_coreference_links;
1087-
print "number of key coreference links: " . $num_key_coreference_links . "\n";
1096+
print "number of key coreference links: " . $num_key_coreference_links . "\n" if ($VERBOSE > 2);
10881097

10891098
my $num_response_coreference_links = keys %$response_coreference_links;
1090-
print "number of response coreference links: " . $num_response_coreference_links . "\n";
1099+
print "number of response coreference links: " . $num_response_coreference_links . "\n" if ($VERBOSE > 2);
10911100

10921101
my $num_key_non_coreference_links = keys %$key_non_coreference_links;
1093-
print "number of key non-coreference links: " . $num_key_non_coreference_links . "\n";
1102+
print "number of key non-coreference links: " . $num_key_non_coreference_links . "\n" if ($VERBOSE > 2);
10941103

10951104
my $num_response_non_coreference_links = keys %$response_non_coreference_links;
1096-
print "number of response non-coreference links: " . $num_response_non_coreference_links . "\n";
1105+
print "number of response non-coreference links: " . $num_response_non_coreference_links . "\n" if ($VERBOSE > 2);
10971106

10981107
my ($r_blanc, $p_blanc, $f_blanc) = ComputeBLANCFromCounts(
10991108
$num_isect_cl, $num_key_coreference_links, $num_response_coreference_links,
11001109
$num_isect_ncl, $num_key_non_coreference_links, $num_response_non_coreference_links);
11011110

1102-
print " blanc recall: " . $r_blanc . "\n";
1103-
print "blanc precision: " . $p_blanc . "\n";
1104-
print " blanc score: " . $f_blanc . "\n";
1105-
print ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>\n";
1111+
print " blanc recall: " . $r_blanc . "\n" if ($VERBOSE > 2);
1112+
print "blanc precision: " . $p_blanc . "\n" if ($VERBOSE > 2);
1113+
print " blanc score: " . $f_blanc . "\n" if ($VERBOSE > 2);
1114+
print ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>\n" if ($VERBOSE > 2);
11061115

11071116
return ($num_isect_cl, $num_key_coreference_links, $num_isect_cl, $num_response_coreference_links,
11081117
$num_isect_ncl, $num_key_non_coreference_links, $num_isect_ncl,$num_response_non_coreference_links);
@@ -1122,24 +1131,24 @@ sub ComputeBLANCFromCounts {
11221131
my $kcl_recall = ($num_key_coreference_links == 0)?0 : ($num_isect_cl / $num_key_coreference_links);
11231132
my $kcl_precision = ($num_response_coreference_links == 0)?0 : ($num_isect_cl / $num_response_coreference_links);
11241133

1125-
print "<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n";
1126-
print " coreference recall: " . $kcl_recall . "\n";
1127-
print " coreference precision: " . $kcl_precision . "\n";
1134+
print "<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n" if ($VERBOSE > 2);
1135+
print " coreference recall: " . $kcl_recall . "\n" if ($VERBOSE > 2);
1136+
print " coreference precision: " . $kcl_precision . "\n" if ($VERBOSE > 2);
11281137

11291138

11301139
my $fcl = ($kcl_recall + $kcl_precision == 0)? 0: (2 * $kcl_recall * $kcl_precision / ($kcl_recall + $kcl_precision));
1131-
print " coreference f-score: " . $fcl . "\n";
1140+
print " coreference f-score: " . $fcl . "\n" if ($VERBOSE > 2);
11321141

11331142
my $kncl_recall = ($num_key_non_coreference_links == 0)? 0 : ($num_isect_ncl / $num_key_non_coreference_links);
11341143
my $kncl_precision = ($num_response_non_coreference_links == 0)? 0: ($num_isect_ncl / $num_response_non_coreference_links);
11351144

1136-
print "--------------------------------------------------------------------------------\n";
1137-
print " non-coreference recall: " . $kncl_recall . "\n";
1138-
print "non-coreference precision: " . $kncl_precision . "\n";
1145+
print "--------------------------------------------------------------------------------\n" if ($VERBOSE > 2);
1146+
print " non-coreference recall: " . $kncl_recall . "\n" if ($VERBOSE > 2);
1147+
print "non-coreference precision: " . $kncl_precision . "\n" if ($VERBOSE > 2);
11391148

11401149
my $fncl = ($kncl_recall + $kncl_precision == 0)? 0 : (2 * $kncl_recall * $kncl_precision / ($kncl_recall + $kncl_precision));
1141-
print " non-coreference f-score: " . $fncl . "\n";
1142-
print "--------------------------------------------------------------------------------\n";
1150+
print " non-coreference f-score: " . $fncl . "\n" if ($VERBOSE > 2);
1151+
print "--------------------------------------------------------------------------------\n" if ($VERBOSE > 2);
11431152

11441153

11451154
my $r_blanc = -1;

0 commit comments

Comments
 (0)