@@ -25,9 +25,10 @@ use Algorithm::Munkres;
25
25
use Data::Dumper;
26
26
# use Algorithm::Combinatorics qw(combinations);
27
27
use Math::Combinatorics;
28
+ use Cwd;
28
29
29
- our $VERSION = ' 7 .0' ;
30
- print " version: " .$VERSION ." \n " ;
30
+ our $VERSION = ' 8 .0' ;
31
+ print " version: " .$VERSION ." " .Cwd::realpath( __FILE__ ). " \n " ;
31
32
32
33
#
33
34
# 7.0 Removed code to compute *_cs metrics
@@ -871,32 +872,40 @@ sub BLANC_Internal
871
872
my ($ga , $gr , $ba , $br ) = (0, 0, 0, 0);
872
873
my $key_coreference_links = {};
873
874
my $key_non_coreference_links = {};
874
-
875
875
my $response_coreference_links = {};
876
876
my $response_non_coreference_links = {};
877
877
878
878
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) ;
881
881
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);
887
894
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);
890
896
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);
897
906
898
907
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) ;
900
909
for my $kkk (@$keys )
901
910
{
902
911
my $ccombinat = Math::Combinatorics-> new(count => 2,
@@ -905,20 +914,20 @@ sub BLANC_Internal
905
914
906
915
while (my @zcombo = $ccombinat -> next_combination)
907
916
{
908
- print Dumper [@zcombo ];
917
+ print Dumper [@zcombo ] if ( $VERBOSE > 2) ;
909
918
my @zzcombo = sort {$a <=> $b } @zcombo ;
910
919
911
920
$key_coreference_links -> {$zzcombo [0] . " -" . $zzcombo [1]} = 1;
912
921
}
913
922
914
- print " ................................................................................\n " ;
923
+ print " ................................................................................\n " if ( $VERBOSE > 2) ;
915
924
}
916
925
917
- print Dumper $key_coreference_links ;
918
- print " ********************************************************************************\n " ;
926
+ print Dumper $key_coreference_links if ( $VERBOSE > 2) ;
927
+ print " ********************************************************************************\n " if ( $VERBOSE > 2) ;
919
928
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) ;
922
931
for my $rrr (@$response )
923
932
{
924
933
my $ccombinat = Math::Combinatorics-> new(count => 2,
@@ -927,20 +936,20 @@ sub BLANC_Internal
927
936
928
937
while (my @zcombo = $ccombinat -> next_combination)
929
938
{
930
- print Dumper [@zcombo ];
939
+ print Dumper [@zcombo ] if ( $VERBOSE > 2) ;
931
940
my @zzcombo = sort {$a <=> $b } @zcombo ;
932
941
933
942
$response_coreference_links -> {$zzcombo [0] . " -" . $zzcombo [1]} = 1;
934
943
}
935
944
936
- print " ................................................................................\n " ;
945
+ print " ................................................................................\n " if ( $VERBOSE > 2) ;
937
946
}
938
947
939
- print Dumper $response_coreference_links ;
940
- print " ********************************************************************************\n " ;
948
+ print Dumper $response_coreference_links if ( $VERBOSE > 2) ;
949
+ print " ********************************************************************************\n " if ( $VERBOSE > 2) ;
941
950
942
951
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) ;
944
953
945
954
my @s = (0..$number_chains_in_key - 1);
946
955
my $ss = join (' ' , @s );
@@ -950,8 +959,8 @@ sub BLANC_Internal
950
959
data => [@n ],
951
960
);
952
961
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) ;
955
964
956
965
while (my @combo = $combinat -> next_combination){
957
966
@@ -962,32 +971,32 @@ sub BLANC_Internal
962
971
}
963
972
964
973
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) ;
969
978
my @kccar = cartesian($kcombo [0], $kcombo [1]);
970
979
971
980
foreach my $x (@kccar )
972
981
{
973
- print " --->>>>>>>>>>>>\n " ;
974
- print Dumper $x ;
982
+ print " --->>>>>>>>>>>>\n " if ( $VERBOSE > 2) ;
983
+ print Dumper $x if ( $VERBOSE > 2) ;
975
984
my @y = sort {$a <=> $b } @$x ;
976
- print Dumper [@y ];
985
+ print Dumper [@y ] if ( $VERBOSE > 2) ;
977
986
$key_non_coreference_links -> {@y [0] . " -" . @y [1]} = 1
978
987
}
979
988
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) ;
982
991
983
- print " .....\n " ;
992
+ print " .....\n " if ( $VERBOSE > 2) ;
984
993
985
- print " \n " ;
994
+ print " \n " if ( $VERBOSE > 2) ;
986
995
}
987
996
988
- print " \n " ;
997
+ print " \n " if ( $VERBOSE > 2) ;
989
998
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) ;
991
1000
992
1001
my @s = (0..$number_chains_in_response - 1);
993
1002
my $ss = join (' ' , @s );
@@ -997,8 +1006,8 @@ sub BLANC_Internal
997
1006
data => [@n ],
998
1007
);
999
1008
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) ;
1002
1011
1003
1012
while (my @combo = $combinat -> next_combination){
1004
1013
my @kcombo = ();
@@ -1008,101 +1017,101 @@ sub BLANC_Internal
1008
1017
}
1009
1018
1010
1019
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) ;
1015
1024
my @kccar = cartesian($kcombo [0], $kcombo [1]);
1016
1025
1017
1026
foreach my $x (@kccar )
1018
1027
{
1019
- print " --->>>>>>>>>>>>\n " ;
1020
- print Dumper $x ;
1028
+ print " --->>>>>>>>>>>>\n " if ( $VERBOSE > 2) ;
1029
+ print Dumper $x if ( $VERBOSE > 2) ;
1021
1030
my @y = sort {$a <=> $b } @$x ;
1022
- print Dumper [@y ];
1031
+ print Dumper [@y ] if ( $VERBOSE > 2) ;
1023
1032
$response_non_coreference_links -> {@y [0] . " -" . @y [1]} = 1
1024
1033
}
1025
1034
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) ;
1028
1037
1029
- print " .....\n " ;
1030
- print " \n " ;
1038
+ print " .....\n " if ( $VERBOSE > 2) ;
1039
+ print " \n " if ( $VERBOSE > 2) ;
1031
1040
}
1032
1041
1033
- print " \n " ;
1042
+ print " \n " if ( $VERBOSE > 2) ;
1034
1043
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) ;
1041
1050
1042
1051
my @union_cl = my @isect_cl = ();
1043
1052
my %union_cl = my %isect_cl = ();
1044
1053
1045
1054
my @kcl = keys %$key_coreference_links ;
1046
1055
my @rcl = keys %$response_coreference_links ;
1047
1056
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) ;
1052
1061
1053
1062
foreach my $e (@kcl , @rcl ) { $union_cl {$e }++ && $isect_cl {$e }++}
1054
1063
1055
1064
@union_cl = keys %union_cl ;
1056
1065
@isect_cl = keys %isect_cl ;
1057
1066
1058
- print Dumper @isect_cl ;
1059
- print " ********************************************************************************\n " ;
1067
+ print Dumper @isect_cl if ( $VERBOSE > 2) ;
1068
+ print " ********************************************************************************\n " if ( $VERBOSE > 2) ;
1060
1069
1061
1070
my @union_ncl = my @isect_ncl = ();
1062
1071
my %union_ncl = my %isect_ncl = ();
1063
1072
1064
1073
my @kncl = keys %$key_non_coreference_links ;
1065
1074
my @rncl = keys %$response_non_coreference_links ;
1066
1075
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) ;
1071
1080
1072
1081
foreach my $e (@kncl , @rncl ) { $union_ncl {$e }++ && $isect_ncl {$e }++}
1073
1082
1074
1083
@union_ncl = keys %union_ncl ;
1075
1084
@isect_ncl = keys %isect_ncl ;
1076
1085
1077
- print Dumper @isect_ncl ;
1078
- print " ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n " ;
1086
+ print Dumper @isect_ncl if ( $VERBOSE > 2) ;
1087
+ print " ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n " if ( $VERBOSE > 2) ;
1079
1088
1080
1089
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) ;
1082
1091
1083
1092
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) ;
1085
1094
1086
1095
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) ;
1088
1097
1089
1098
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) ;
1091
1100
1092
1101
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) ;
1094
1103
1095
1104
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) ;
1097
1106
1098
1107
my ($r_blanc , $p_blanc , $f_blanc ) = ComputeBLANCFromCounts(
1099
1108
$num_isect_cl , $num_key_coreference_links , $num_response_coreference_links ,
1100
1109
$num_isect_ncl , $num_key_non_coreference_links , $num_response_non_coreference_links );
1101
1110
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) ;
1106
1115
1107
1116
return ($num_isect_cl , $num_key_coreference_links , $num_isect_cl , $num_response_coreference_links ,
1108
1117
$num_isect_ncl , $num_key_non_coreference_links , $num_isect_ncl ,$num_response_non_coreference_links );
@@ -1122,24 +1131,24 @@ sub ComputeBLANCFromCounts {
1122
1131
my $kcl_recall = ($num_key_coreference_links == 0)?0 : ($num_isect_cl / $num_key_coreference_links );
1123
1132
my $kcl_precision = ($num_response_coreference_links == 0)?0 : ($num_isect_cl / $num_response_coreference_links );
1124
1133
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) ;
1128
1137
1129
1138
1130
1139
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) ;
1132
1141
1133
1142
my $kncl_recall = ($num_key_non_coreference_links == 0)? 0 : ($num_isect_ncl / $num_key_non_coreference_links );
1134
1143
my $kncl_precision = ($num_response_non_coreference_links == 0)? 0: ($num_isect_ncl / $num_response_non_coreference_links );
1135
1144
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) ;
1139
1148
1140
1149
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) ;
1143
1152
1144
1153
1145
1154
my $r_blanc = -1;
0 commit comments