Merge groups on node level
Change-Id: Ibbfa35eb0ce51341eabbabe56f68dab8e8fae9aa
diff --git a/lib/Krawfish/Koral/Compile/Node/Group.pm b/lib/Krawfish/Koral/Compile/Node/Group.pm
new file mode 100644
index 0000000..d34c5ea
--- /dev/null
+++ b/lib/Krawfish/Koral/Compile/Node/Group.pm
@@ -0,0 +1,10 @@
+package Krawfish::Koral::Compile::Node::Group;
+use strict;
+use warnings;
+use Role::Tiny;
+
+requires qw/to_string
+ identify
+ optimize/;
+
+1;
diff --git a/lib/Krawfish/Koral/Compile/Node/Group/ClassFrequencies.pm b/lib/Krawfish/Koral/Compile/Node/Group/ClassFrequencies.pm
index 93bf0c7..3abe798 100644
--- a/lib/Krawfish/Koral/Compile/Node/Group/ClassFrequencies.pm
+++ b/lib/Krawfish/Koral/Compile/Node/Group/ClassFrequencies.pm
@@ -2,10 +2,14 @@
use Krawfish::Compile::Segment::Group::ClassFrequencies;
use Krawfish::Util::String qw/squote/;
use Krawfish::Compile::Segment::Nowhere;
+use Role::Tiny::With;
use strict;
use warnings;
+with 'Krawfish::Koral::Compile::Node::Group';
+
+
# Create new enrichment object for fields
sub new {
my $class = shift;
diff --git a/lib/Krawfish/Koral/Compile/Node/Group/Fields.pm b/lib/Krawfish/Koral/Compile/Node/Group/Fields.pm
index b2dfda4..e7aedb7 100644
--- a/lib/Krawfish/Koral/Compile/Node/Group/Fields.pm
+++ b/lib/Krawfish/Koral/Compile/Node/Group/Fields.pm
@@ -2,10 +2,14 @@
use Krawfish::Compile::Segment::Group::Fields;
use Krawfish::Util::String qw/squote/;
use Krawfish::Compile::Segment::Nowhere;
+use Role::Tiny::With;
use strict;
use warnings;
+with 'Krawfish::Koral::Compile::Node::Group';
+
+
# Create new enrichment object for fields
sub new {
my $class = shift;
diff --git a/lib/Krawfish/Koral/Result.pm b/lib/Krawfish/Koral/Result.pm
index 9eaa5e9..5a37452 100644
--- a/lib/Krawfish/Koral/Result.pm
+++ b/lib/Krawfish/Koral/Result.pm
@@ -80,7 +80,6 @@
print_log('k_result', 'Add aggregation data for ' . $new_aggr->key);
};
-
# Introduce aggregation
$self->add_aggregation($new_aggr);
};
@@ -88,6 +87,34 @@
return;
};
+# Merge groups
+sub merge_group {
+ my ($self, $group) = @_;
+
+ if (DEBUG) {
+ print_log('k_result', 'Merge group data');
+ };
+
+ # Merge with existing group
+ if ($self->{group}) {
+
+ if ($self->{group}->key ne $group->key) {
+ $self->add_error(000 => 'Groups are not compatible');
+ delete $self->{group};
+ return;
+ };
+
+ # Merge
+ $self->{group}->merge($group);
+ }
+
+ # Establish first group
+ else {
+ $self->{group} = $group;
+ };
+
+ return;
+};
# Get aggregations
sub aggregation {
diff --git a/lib/Krawfish/Koral/Result/Aggregate.pm b/lib/Krawfish/Koral/Result/Aggregate.pm
index 695ce97..956aafb 100644
--- a/lib/Krawfish/Koral/Result/Aggregate.pm
+++ b/lib/Krawfish/Koral/Result/Aggregate.pm
@@ -3,7 +3,13 @@
use warnings;
use Role::Tiny;
-requires qw/key merge/;
+# TODO: Identical to Result::Group
+
+requires qw/key
+ merge
+ inflate
+ to_string
+ to_koral_fragment/;
# Finish the calculation
sub on_finish {
diff --git a/lib/Krawfish/Koral/Result/Group.pm b/lib/Krawfish/Koral/Result/Group.pm
index b199c31..2d81bc4 100644
--- a/lib/Krawfish/Koral/Result/Group.pm
+++ b/lib/Krawfish/Koral/Result/Group.pm
@@ -1,18 +1,20 @@
package Krawfish::Koral::Result::Group;
-use Role::Tiny::With;
+use Role::Tiny;
use strict;
use warnings;
-with 'Krawfish::Koral::Report';
-with 'Krawfish::Koral::Result::Inflatable';
+# TODO: Identical to Result::Aggregate
+
+requires qw/key
+ merge
+ inflate
+ to_string
+ to_koral_fragment/;
# This will be returned by a Group search
# It needs a to_hash method,
# does not require start, end etc ...
-# TODO:
-# This is quite similar to K::P::Bundle
-
# With a witness, the group has:
# {
# criterion => [freq, doc_freq, match]
@@ -31,17 +33,9 @@
# criterion => [freq, doc_freq, match, freq, doc_freq, match, freq, doc_freq, match ...]
# }
-
-sub freq {
- ...
-};
-
-sub doc_freq {
- ...
-};
-
-sub to_hash {
- ...
+sub on_finish {
+ $_[0];
};
1;
+
diff --git a/lib/Krawfish/Koral/Result/Group/Fields.pm b/lib/Krawfish/Koral/Result/Group/Fields.pm
index 868a0bc..765b2d5 100644
--- a/lib/Krawfish/Koral/Result/Group/Fields.pm
+++ b/lib/Krawfish/Koral/Result/Group/Fields.pm
@@ -1,5 +1,6 @@
package Krawfish::Koral::Result::Group::Fields;
use Krawfish::Util::PatternList qw/pattern_list/;
+use Data::Dumper;
use Role::Tiny::With;
use Krawfish::Util::Bits;
use Krawfish::Log;
@@ -8,8 +9,9 @@
use warnings;
with 'Krawfish::Koral::Result::Inflatable';
+with 'Krawfish::Koral::Result::Group';
-use constant DEBUG => 0;
+use constant DEBUG => 1;
# Group on a sequence of field values
@@ -89,12 +91,42 @@
};
};
+
# On finish, flush the cache
sub on_finish {
$_[0]->flush;
$_[0];
};
+
+# Merge groups
+sub merge {
+ my ($self, $group) = @_;
+ my $est_group = $self->{group};
+ my $new_group = $group->{group};
+
+ # Get groups
+ foreach my $signature (keys %{$new_group}) {
+ $est_group->{$signature} //= {};
+
+ if (DEBUG) {
+ print_log('p_g_fields','Result: ' . Dumper $new_group);
+ };
+
+ # Iterate over all existing groups
+ foreach my $flag (keys %{$new_group->{$signature}}) {
+
+ my $value = ($est_group->{$signature}->{$flag} //= [0,0]);
+ my $freq = $new_group->{$signature}->{$flag};
+
+ $value->[0] += $freq->[0];
+ $value->[1] += $freq->[1];
+ };
+ };
+};
+
+
+
# Translate this to terms
sub inflate {
my ($self, $dict) = @_;