=begin testing
+use Set::Scalar;
use Test::More::UTF8;
use Text::Tradition;
use TryCatch;
like( $e->message, qr/Failed to find witness set that is a subset of/,
"Correct error thrown on bad record_grouping attempt" );
}
+# Test manually setting an out-of-range group
+try {
+ $result->_set_grouping( 3, Set::Scalar->new( qw/ X Y / ) );
+ ok( 0, "Set a grouping at an invalid index" );
+} catch ( Text::Tradition::Error $e ) {
+ is( $e->message, 'Set / group index 3 out of range for set_grouping',
+ "Caught attempt to set grouping at invalid index" );
+}
$result->record_grouping( [ qw/ 3 F H / ] );
my $gp1 = $result->grouping(1);
is( $result->minimum_grouping_for( $rsets[1] ), $gp1,
isa => 'ArrayRef[Set::Scalar]',
handles => {
groupings => 'elements',
- _add_grouping => 'push',
_set_grouping => 'set',
grouping => 'get',
},
# Convert the set list into a list of Set::Scalars, ordered first by size and
# then alphabetically by first-sorted.
- die "Must specify a set list to Analysis::Result->new()"
+ throw( "Must specify a set list to Analysis::Result->new()" )
unless ref( $args->{'setlist'} ) eq 'ARRAY';
+ throw( "Empty set list specified to Analysis::Result->new()" )
+ unless @{$args->{'setlist'}};
# Order the sets and make sure they are all distinct Set::Scalars.
$args->{'setlist'} = [ sort { by_size_and_alpha( $a, $b ) }
_check_set_args( $args->{'setlist'} ) ];
} elsif( $type eq 'Graph' ) {
$args->{'graph'} = Text::Tradition::Stemma::editable_graph( $st, $gopt );
} else {
- die "Passed argument to graph that is neither Stemma nor Graph";
+ throw( "Passed argument to graph that is neither Stemma nor Graph" );
}
}
# If our only args are graph and setlist, then status should be 'new'
- $DB::single = 1;
if( scalar keys %$args == 2 ) {
$args->{'status'} = 'new';
}
# Check uniqueness of the current set
if( ref( $set ) ne 'Set::Scalar' ) {
$s = Set::Scalar->new( @$set );
- die "Duplicate element(s) in set or group passed to Analysis::Result->new()"
+ throw( "Duplicate element(s) in set or group passed to Analysis::Result->new()" )
unless @$set == $s->elements;
}
# Check distinctness of the set from all other sets given so far
foreach my $ps ( @sets ) {
- die "Two sets are not disjoint"
+ throw( "Two sets $s / $ps are not disjoint" )
unless $s->is_disjoint( $ps );
}
# Save the set.
my $self = shift;
# Initialize the groupings array
- map { $self->_add_grouping( $_ ) } $self->sets;
+ my @sets = $self->sets;
+ foreach my $idx( 0 .. $#sets ) {
+ unless( $self->grouping( $idx ) ) {
+ $self->_set_grouping( $idx, $sets[$idx] );
+ }
+ }
}
+before '_set_grouping' => sub {
+ my $self = shift;
+ my $idx = $_[0];
+ my $max = scalar $self->sets;
+ if( $idx >= $max ) {
+ throw( "Set / group index $idx out of range for set_grouping" );
+ }
+};
+
=head2 $self->object_key
Returns a unique key that can be used to look up this graph/set combination in
sub request_string {
my $self = shift;
- return string_from_graph_problem( $self->graph, [ $self->sets ] );
-}
-
-# TODO do we need this now?
-
-sub string_from_graph_problem {
- my( $graph, $grouping ) = @_;
- my( $graphstr, @groupsets );
- # Get the graph string
- if( ref( $graph ) && ref( $graph ) eq 'Graph' ) {
- $graphstr = Text::Tradition::Stemma::editable_graph( $graph, { 'linesep' => ' ' } );
- } else {
- throw( "Passed non-graph object $graph to stringification" )
- if ref( $graph );
- $graphstr = $graph;
- }
- # Make sure all groupings are sets
- foreach my $g ( @$grouping ) {
- if( ref( $g ) eq 'ARRAY' ) {
- push( @groupsets, Set::Scalar->new( @$g ) );
- } elsif( ref( $g ) eq 'Set::Scalar' ) {
- push( @groupsets, $g );
- } else {
- throw( "Tried to stringify grouping $g that is neither set nor array" );
- }
- }
- return $graphstr . '//' .
- join( ',', sort { by_size_and_alpha( $a, $b ) } @groupsets );
-}
-
-# TODO do we need this?
-# This should work as $self->problem_json or as problem_json( @objects )
-sub problem_json {
- my( @objects ) = @_;
- # There should be a distinct problem for each unique graph.
- my %distinct_problems;
- foreach my $o ( @objects ) {
- unless( exists $distinct_problems{$o->graph} ) {
- $distinct_problems{$o->graph} = [];
- }
- my @groupings;
- map { push( @groupings, [ $_->members ] ) } $o->sets;
- push( @{$distinct_problems{$o->graph}}, \@groupings );
- }
- my @pstrs = map { to_json(
- { graph => $_, groupings => $distinct_problems{$_} } ) }
- keys %distinct_problems;
- return @pstrs;
+ return $self->graph . '//' . join( ',', $self->sets );
}
=head2 by_size_and_alpha