if( ref( $arg ) eq 'Text::Tradition::Collation::Reading' ) {
$arg = $arg->id;
}
-
# Remove the reading from the graphs.
$self->sequence->delete_vertex( $arg );
$self->relations->delete_vertex( $arg );
# We only need the IDs for adding paths to the graph, not the reading
# objects themselves.
- my( $kept, $deleted ) = $self->_stringify_args( @_ );
+ my( $kept, $deleted, $combine_char ) = $self->_stringify_args( @_ );
# The kept reading should inherit the paths and the relationships
# of the deleted reading.
my @vector = ( $kept );
push( @vector, $path->[1] ) if $path->[0] eq $deleted;
unshift( @vector, $path->[0] ) if $path->[1] eq $deleted;
+ next if $vector[0] eq $vector[1]; # Don't add a self loop
my %wits = %{$self->sequence->get_edge_attributes( @$path )};
$self->sequence->add_edge( @vector );
my $fwits = $self->sequence->get_edge_attributes( @vector );
foreach my $rel ( $self->relations->edges_at( $deleted ) ) {
my @vector = ( $kept );
push( @vector, $rel->[0] eq $deleted ? $rel->[1] : $rel->[0] );
+ next if $vector[0] eq $vector[1]; # Don't add a self loop
# Is there a relationship here already? If so, keep it.
# TODO Warn about conflicting relationships
next if $self->relations->has_edge( @vector );
}
# Do the deletion deed.
+ if( $combine_char ) {
+ my $kept_obj = $self->reading( $kept );
+ my $new_text = join( $combine_char, $kept_obj->text,
+ $self->reading( $deleted )->text );
+ $kept_obj->alter_text( $new_text );
+ }
$self->del_reading( $deleted );
}
sub del_path {
my $self = shift;
+ my @args;
+ if( ref( $_[0] ) eq 'ARRAY' ) {
+ my $e = shift @_;
+ @args = ( @$e, @_ );
+ } else {
+ @args = @_;
+ }
# We only need the IDs for adding paths to the graph, not the reading
# objects themselves.
- my( $source, $target, $wit ) = $self->_stringify_args( @_ );
+ my( $source, $target, $wit ) = $self->_stringify_args( @args );
if( $self->sequence->has_edge_attribute( $source, $target, $wit ) ) {
- $self->sequence->del_edge_attribute( $source, $target, $wit );
+ $self->sequence->delete_edge_attribute( $source, $target, $wit );
}
unless( keys %{$self->sequence->get_edge_attributes( $source, $target )} ) {
$self->sequence->delete_edge( $source, $target );
# Check the options
if( !defined $options->{'type'} ||
- $options->{'type'} !~ /^(spelling|orthographic|grammatical|meaning|repetition|transposition)$/i ) {
+ $options->{'type'} !~ /^(spelling|orthographic|grammatical|meaning|lexical|collated|repetition|transposition)$/i ) {
my $t = $options->{'type'} ? $options->{'type'} : '';
- return( undef, "Invalid or missing type" . $options->{'type'} );
+ return( undef, "Invalid or missing type " . $options->{'type'} );
}
- if( $options->{'type'} =~ /^(spelling|orthographic|grammatical|meaning)$/ ) {
+ unless ( $options->{'type'} =~ /^(repetition|transposition)$/ ) {
$options->{'colocated'} = 1;
}
# to a path loop for any witness. First make a lookup table of all the
# readings related to either the source or the target.
my @proposed_related = ( $source, $target );
- push( @proposed_related, $source->related_readings( 'colocated' ) );
- push( @proposed_related, $target->related_readings( 'colocated' ) );
+ push( @proposed_related, $self->related_readings( $source, 'colocated' ) );
+ push( @proposed_related, $self->related_readings( $target, 'colocated' ) );
my %pr_ids;
- map { $pr_ids{ $_->id } = 1 } @proposed_related;
+ map { $pr_ids{ $_ } = 1 } @proposed_related;
# None of these proposed related readings should have a neighbor that
# is also in proposed_related.
print $graph->as_svg( $recalculate );
-Returns an SVG string that represents the graph. Uses GraphViz to do
-this, because Graph::Easy doesn\'t cope well with long graphs. Unless
-$recalculate is passed (and is a true value), the method will return a
-cached copy of the SVG after the first call to the method.
+Returns an SVG string that represents the graph, via as_dot and graphviz.
=cut
foreach my $reading ( $self->readings ) {
# Need not output nodes without separate labels
next if $reading->id eq $reading->text;
- $dot .= sprintf( "\t\"%s\" [ label=\"%s\" ];\n", $reading->id, $reading->text );
+ my $label = $reading->text;
+ $label =~ s/\"/\\\"/g;
+ $dot .= sprintf( "\t\"%s\" [ label=\"%s\" ];\n", $reading->id, $label );
}
# TODO do something sensible for relationships
foreach my $edge ( @edges ) {
my %variables = ( 'color' => '#000000',
'fontcolor' => '#000000',
- 'label' => join( ', ', $self->path_witnesses( $edge ) ),
+ 'label' => join( ', ', $self->path_display_label( $edge ) ),
);
my $varopts = join( ', ', map { $_.'="'.$variables{$_}.'"' } sort keys %variables );
$dot .= sprintf( "\t\"%s\" -> \"%s\" [ %s ];\n",
return sort @wits;
}
+sub path_display_label {
+ my( $self, $edge ) = @_;
+ my @wits = $self->path_witnesses( $edge );
+ my $maj = scalar( $self->tradition->witnesses ) * 0.6;
+ if( scalar @wits > $maj ) {
+ return 'majority';
+ } else {
+ return join( ', ', @wits );
+ }
+}
+
+
=item B<as_graphml>
print $graph->as_graphml( $recalculate )
my $ndi = 0;
my %node_data = (
id => 'string',
- reading => 'string',
+ text => 'string',
rank => 'string',
is_start => 'boolean',
is_end => 'boolean',
my $node_xmlid = 'n' . $node_ctr++;
$node_hash{ $n->id } = $node_xmlid;
$node_el->setAttribute( 'id', $node_xmlid );
- _add_graphml_data( $node_el, $node_data_keys{'id'}, $n->id );
- _add_graphml_data( $node_el, $node_data_keys{'reading'}, $n->text );
- _add_graphml_data( $node_el, $node_data_keys{'rank'}, $n->rank )
- if $n->has_rank;
+ foreach my $d ( keys %node_data ) {
+ my $nval = $n->$d;
+ _add_graphml_data( $node_el, $node_data_keys{$d}, $nval )
+ if defined $nval;
+ }
}
# Add the path edges
$seen{$n->id} = 1;
my $next = $self->next_reading( $n, $witness, $backup );
- $DB::single = 1 if $next->id eq $end->id;
unless( $next ) {
warn "Did not find any path for $witness from reading " . $n->id;
last;
sub make_witness_paths {
my( $self ) = @_;
foreach my $wit ( $self->tradition->witnesses ) {
- print STDERR "Making path for " . $wit->sigil . "\n";
+ # print STDERR "Making path for " . $wit->sigil . "\n";
$self->make_witness_path( $wit );
}
}
foreach my $n ( $self->sequence->successors( $r->id ) ) {
my( $tfrom, $tto ) = ( $rel_containers{$r->id},
$rel_containers{$n} );
+ $DB::single = 1 unless $tfrom && $tto;
$topo_graph->add_edge( $tfrom, $tto );
}
}
my $key = $rdg->rank . "||" . $rdg->text;
if( exists $unique_rank_rdg{$key} ) {
# Combine!
- print STDERR "Combining readings at same rank: $key\n";
+ # print STDERR "Combining readings at same rank: $key\n";
$self->merge_readings( $unique_rank_rdg{$key}, $rdg );
} else {
$unique_rank_rdg{$key} = $rdg;
=over
-=item * Rationalize edge classes
-
-=item * Port the internal graph from Graph::Easy to Graph
+=item * Think about making Relationship objects again
=back
projects / scpubgit/stemmatology.git / blobdiff