Implement ordinal and ratio deltas, rename jaccard

Author: choroba

lib/Statistics/Krippendorff.pm

@@ -81,7 +81,15 @@ sub delta_nominal($, $s1, $s2) { $s1 eq $s2 ? 0 : 1 }
 
 sub delta_interval($, $v0, $v1) { ($v0 - $v1) ** 2 }
 
-sub jaccard_index($, $s1, $s2) {
+sub delta_ordinal($self, $v0, $v1) {
+    my ($from, $to) = sort { $a <=> $b } $v0, $v1;
+    (sum(map $self->frequency($_), $from .. $to)
+     - ($self->frequency($from) + $self->frequency($to))/ 2) ** 2
+}
+
+sub delta_ratio($self, $v0, $v1) { (($v0 - $v1) / ($v0 + $v1)) ** 2}
+
+sub delta_jaccard($, $s1, $s2) {
     my @s1 = split /,/, $s1;
     my @s2 = split /,/, $s2;
 
@@ -226,13 +234,18 @@ Used for nominal data, i.e. labels with no ordering.
 Used for numeric values that are ordered, but can't be used in mathematical
 operations, for example number of stars in a movie rating system (we don't say
 that the distance from one star to two stars is the same as the distance from
-three starts to four stars).
+three starts to four stars). See the implementation on why C<$self> is needed
+as a parameter to delta.
 
 =head4 delta_interval
 
 Used for numeric values that can be used in mathematical operations.
 
-=head4 jaccard_index
+=head4 delta_ratio
+
+Used for non-negative numeric values (think degrees Kelvin).
+
+=head4 delta_jaccard
 
 This can be used when coders can specify more than one value. Join the values
 with commas; Jaccard index then uses the formula C<intersection_size /

t/01-deltas.t

@@ -12,20 +12,20 @@ my $sk = 'Statistics::Krippendorff'->new(units => []);
 is $sk->delta_nominal('a', 'a'), 0, 'nominal a-a';
 is $sk->delta_nominal('a', 'b'), 1, 'nominal a-b';
 
-is $sk->jaccard_index('a', 'a'), 0, 'a a';
-is $sk->jaccard_index('a', 'b'), 1, 'a b';
-
-is $sk->jaccard_index('a', 'a,b'), 0.5, 'a ab';
-is $sk->jaccard_index('a', 'b,a'), 0.5, 'a ba';
-is $sk->jaccard_index('a,b', 'a'), 0.5, 'ab a';
-is $sk->jaccard_index('b,a', 'a'), 0.5, 'ba a';
-
-is $sk->jaccard_index('a,b', 'c,d'), 1, 'ab cd';
-is $sk->jaccard_index('a,b', 'a,b'), 0, 'ab ab';
-is $sk->jaccard_index('a,b', 'b,a'), 0, 'ab ba';
-is $sk->jaccard_index('a,b', 'a,c'), 2/3, 'ab ac';
-is $sk->jaccard_index('a,b', 'c,a'), 2/3, 'ab ca';
-is $sk->jaccard_index('b,a', 'c,a'), 2/3, 'ba ca';
-is $sk->jaccard_index('b,a', 'a,c'), 2/3, 'ba ac';
-
-is $sk->jaccard_index('a,b,c', 'b,c,d,e'), 3/5, 'abc bcde';
+is $sk->delta_jaccard('a', 'a'), 0, 'a a';
+is $sk->delta_jaccard('a', 'b'), 1, 'a b';
+
+is $sk->delta_jaccard('a', 'a,b'), 0.5, 'a ab';
+is $sk->delta_jaccard('a', 'b,a'), 0.5, 'a ba';
+is $sk->delta_jaccard('a,b', 'a'), 0.5, 'ab a';
+is $sk->delta_jaccard('b,a', 'a'), 0.5, 'ba a';
+
+is $sk->delta_jaccard('a,b', 'c,d'), 1, 'ab cd';
+is $sk->delta_jaccard('a,b', 'a,b'), 0, 'ab ab';
+is $sk->delta_jaccard('a,b', 'b,a'), 0, 'ab ba';
+is $sk->delta_jaccard('a,b', 'a,c'), 2/3, 'ab ac';
+is $sk->delta_jaccard('a,b', 'c,a'), 2/3, 'ab ca';
+is $sk->delta_jaccard('b,a', 'c,a'), 2/3, 'ba ca';
+is $sk->delta_jaccard('b,a', 'a,c'), 2/3, 'ba ac';
+
+is $sk->delta_jaccard('a,b,c', 'b,c,d,e'), 3/5, 'abc bcde';

t/02-example.t

@@ -5,37 +5,66 @@ use strict;
 use Statistics::Krippendorff;
 
 use Test2::V0;
-plan 3;
+use Test2::Tools::Subtest qw{ subtest_buffered };
+plan 2;
 
-{   my @units = ({B=>2, C=>2}, {B=>1, C=>1}, {B=>3, C=>3}, {A=>3, B=>3, C=>4},
-                 {A=>4, B=>4, C=>4}, {A=>1, B=>3}, {A=>2, C=>2}, {A=>1, C=>1},
-                 {A=>1, C=>1}, {A=>3, C=>3}, {A=>3, C=>3}, {A=>3, C=>4});
-    my $sk = 'Statistics::Krippendorff'->new(
-        units => \@units,
+subtest_buffered wikipedia => sub {
+    plan 3;
+    my @units_h = ({B=>2, C=>2}, {B=>1, C=>1}, {B=>3, C=>3}, {A=>3, B=>3, C=>4},
+                   {A=>4, B=>4, C=>4}, {A=>1, B=>3}, {A=>2, C=>2}, {A=>1, C=>1},
+                   {A=>1, C=>1}, {A=>3, C=>3}, {A=>3, C=>3}, {A=>3, C=>4});
+    my $sk1 = 'Statistics::Krippendorff'->new(
+        units => \@units_h,
         delta => \&Statistics::Krippendorff::delta_nominal);
 
-    is $sk->alpha, float(0.691, precision => 3),
-        'Wikipedia example hashes';
-}
-
-{   my @units = ([undef, 2, 2],
-                 [undef, 1, 1],
-                 [undef, 3, 3],
-                 [3, 3, 4],
-                 [4, 4, 4],
-                 [1, 3],
-                 [2, undef, 2],
-                 [1, undef, 1],
-                 [1, undef, 1],
-                 [3, undef, 3],
-                 [3, undef, 3],
-                 [3, undef, 4]);
+    is $sk1->alpha, float(0.691, precision => 3),
+        'Hash units, default delta';
 
+    my @units_a = ([undef, 2, 2],
+                   [undef, 1, 1],
+                   [undef, 3, 3],
+                   [3, 3, 4],
+                   [4, 4, 4],
+                   [1, 3],
+                   [2, undef, 2],
+                   [1, undef, 1],
+                   [1, undef, 1],
+                   [3, undef, 3],
+                   [3, undef, 3],
+                   [3, undef, 4]);
+
+    my $sk2 = 'Statistics::Krippendorff'->new(units => \@units_a);
+    is $sk2->alpha, float(0.691, precision => 3),
+        'Array units, default delta';
+
+    $sk2->delta(\&Statistics::Krippendorff::delta_interval);
+    is $sk2->alpha, float(0.811, precision => 3),
+        'Array units, interval delta';
+};
+
+subtest_buffered krippendorf_1980 => sub {
+    plan 4;
+
+    my @units = ([1,1,undef,1],[2,2,3,2],[3,3,3,3],[3,3,3,3],[2,2,2,2],
+                 [1,2,3,4],[4,4,4,4],[1,1,2,1],[2,2,2,2],[undef,5,5,5],
+                 [undef,undef,1,1]);
     my $sk = 'Statistics::Krippendorff'->new(units => \@units);
-    is $sk->alpha, float(0.691, precision => 3),
-        'Wikipedia example array, default delta';
+
+    is $sk->alpha, float(0.743, precision => 3),
+        'nominal';
 
     $sk->delta(\&Statistics::Krippendorff::delta_interval);
-    is $sk->alpha, float(0.811, precision => 3),
-        'Wikipedia example interval';
-}
+    is $sk->alpha, float(0.849, precision => 3),
+        'interval';
+
+    $sk->delta(\&Statistics::Krippendorff::delta_ordinal);
+    is $sk->alpha, float(0.815, precision => 3),
+        'oridnal';
+
+    $sk->delta(\&Statistics::Krippendorff::delta_ratio);
+    is $sk->alpha, float(0.797, precision => 3),
+        'ratio';
+
+
+
+};

t/04-jaccard.t

@@ -9,15 +9,15 @@ use Test2::V0;
 my $sk1 = 'Statistics::Krippendorff'->new(
     units => [['a,b', 'b,a'], ['b,c', 'c,b'], ['e,f', 'f,e'],
               ['x', 'b,a'],['a', 'a,b']],
-    delta => \&Statistics::Krippendorff::jaccard_index
+    delta => \&Statistics::Krippendorff::delta_jaccard
 );
 
 my $alpha1 = $sk1->alpha;
 
 my $sk2 = 'Statistics::Krippendorff'->new(
     units => [['a,b', 'a,b'], ['b,c', 'b,c'], ['e,f', 'e,f'],
               ['b,a', 'x'], ['a', 'b,a']],
-    delta => \&Statistics::Krippendorff::jaccard_index
+    delta => \&Statistics::Krippendorff::delta_jaccard
 );
 is $sk2->alpha, float($alpha1, precision => 8),
     q(Order inside values doesn't matter);