next unless @noncolo;
foreach my $nc ( @noncolo ) {
unless( $self->relations->verify_or_delete( $rdg, $nc ) ) {
- push( @deleted_relations, $nc );
+ push( @deleted_relations, [ $rdg->id, $nc->id ] );
}
}
}
foreach my $edge ( @edges ) {
# Do we need to output this edge?
if( $used{$edge->[0]} && $used{$edge->[1]} ) {
- my $label = $self->_path_display_label( $self->path_witnesses( $edge ) );
+ my $label = $self->_path_display_label( $opts,
+ $self->path_witnesses( $edge ) );
my $variables = { %edge_attrs, 'label' => $label };
# Account for the rank gap if necessary
# Add substitute start and end edges if necessary
foreach my $node ( keys %substart ) {
- my $witstr = $self->_path_display_label ( $self->path_witnesses( $substart{$node}, $node ) );
+ my $witstr = $self->_path_display_label( $opts,
+ $self->path_witnesses( $substart{$node}, $node ) );
my $variables = { %edge_attrs, 'label' => $witstr };
my $nrdg = $self->reading( $node );
if( $nrdg->has_rank && $nrdg->rank > $startrank ) {
$dot .= "\t\"__SUBSTART__\" -> \"$node\" $varopts;\n";
}
foreach my $node ( keys %subend ) {
- my $witstr = $self->_path_display_label ( $self->path_witnesses( $node, $subend{$node} ) );
+ my $witstr = $self->_path_display_label( $opts,
+ $self->path_witnesses( $node, $subend{$node} ) );
my $variables = { %edge_attrs, 'label' => $witstr };
my $varopts = _dot_attr_string( $variables );
$dot .= "\t\"$node\" -> \"__SUBEND__\" $varopts;\n";
# witnesses only where the main witness is not also in the list.
sub _path_display_label {
my $self = shift;
+ my $opts = shift;
my %wits;
map { $wits{$_} = 1 } @_;
}
}
- # See if we are in a majority situation.
- my $maj = scalar( $self->tradition->witnesses ) * 0.6;
- $maj = $maj > 5 ? $maj : 5;
- if( scalar keys %wits > $maj ) {
- unshift( @disp_ac, 'majority' );
- return join( ', ', @disp_ac );
- } else {
+ if( $opts->{'explicit_wits'} ) {
return join( ', ', sort keys %wits );
+ } else {
+ # See if we are in a majority situation.
+ my $maj = scalar( $self->tradition->witnesses ) * 0.6;
+ $maj = $maj > 5 ? $maj : 5;
+ if( scalar keys %wits > $maj ) {
+ unshift( @disp_ac, 'majority' );
+ return join( ', ', @disp_ac );
+ } else {
+ return join( ', ', sort keys %wits );
+ }
}
}
Returns a CSV alignment table representation of the collation graph, one
row per witness (or witness uncorrected.)
+=head2 as_tsv
+
+Returns a tab-separated alignment table representation of the collation graph,
+one row per witness (or witness uncorrected.)
+
+=begin testing
+
+use Text::Tradition;
+use Text::CSV;
+
+my $READINGS = 311;
+my $PATHS = 361;
+my $WITS = 13;
+my $WITAC = 4;
+
+my $datafile = 't/data/florilegium_tei_ps.xml';
+my $tradition = Text::Tradition->new( 'input' => 'TEI',
+ 'name' => 'test0',
+ 'file' => $datafile,
+ 'linear' => 1 );
+
+my $c = $tradition->collation;
+# Export the thing to CSV
+my $csvstr = $c->as_csv();
+# Count the columns
+my $csv = Text::CSV->new({ sep_char => ',', binary => 1 });
+my @lines = split(/\n/, $csvstr );
+ok( $csv->parse( $lines[0] ), "Successfully parsed first line of CSV" );
+is( scalar( $csv->fields ), $WITS + $WITAC, "CSV has correct number of witness columns" );
+my $t2 = Text::Tradition->new( input => 'Tabular',
+ name => 'test2',
+ string => $csvstr,
+ sep_char => ',' );
+is( scalar $t2->collation->readings, $READINGS, "Reparsed CSV collation has all readings" );
+is( scalar $t2->collation->paths, $PATHS, "Reparsed CSV collation has all paths" );
+
+# Now do it with TSV
+my $tsvstr = $c->as_tsv();
+my $t3 = Text::Tradition->new( input => 'Tabular',
+ name => 'test3',
+ string => $tsvstr,
+ sep_char => "\t" );
+is( scalar $t3->collation->readings, $READINGS, "Reparsed TSV collation has all readings" );
+is( scalar $t3->collation->paths, $PATHS, "Reparsed TSV collation has all paths" );
+
+my $noaccsv = $c->as_csv({ noac => 1 });
+my @noaclines = split(/\n/, $noaccsv );
+ok( $csv->parse( $noaclines[0] ), "Successfully parsed first line of no-ac CSV" );
+is( scalar( $csv->fields ), $WITS, "CSV has correct number of witness columns" );
+
+
+=end testing
+
=cut
-sub as_csv {
- my( $self ) = @_;
- my $table = $self->alignment_table;
- my $csv = Text::CSV->new( { binary => 1, quote_null => 0 } );
+sub _tabular {
+ my( $self, $opts ) = @_;
+ my $table = $self->alignment_table( $opts );
+ my $csv_options = { binary => 1, quote_null => 0 };
+ $csv_options->{'sep_char'} = $opts->{fieldsep};
+ if( $opts->{fieldsep} eq "\t" ) {
+ # If it is really tab separated, nothing is an escape char.
+ $csv_options->{'quote_char'} = undef;
+ $csv_options->{'escape_char'} = '';
+ }
+ my $csv = Text::CSV->new( $csv_options );
my @result;
# Make the header row
$csv->combine( map { $_->{'witness'} } @{$table->{'alignment'}} );
- push( @result, decode_utf8( $csv->string ) );
+ push( @result, $csv->string );
# Make the rest of the rows
foreach my $idx ( 0 .. $table->{'length'} - 1 ) {
my @rowobjs = map { $_->{'tokens'}->[$idx] } @{$table->{'alignment'}};
my @row = map { $_ ? $_->{'t'}->text : $_ } @rowobjs;
$csv->combine( @row );
- push( @result, decode_utf8( $csv->string ) );
+ push( @result, $csv->string );
}
return join( "\n", @result );
}
+sub as_csv {
+ my $self = shift;
+ my $opts = shift || {};
+ $opts->{fieldsep} = ',';
+ return $self->_tabular( $opts );
+}
+
+sub as_tsv {
+ my $self = shift;
+ my $opts = shift || {};
+ $opts->{fieldsep} = "\t";
+ return $self->_tabular( $opts );
+}
+
=head2 alignment_table
Return a reference to an alignment table, in a slightly enhanced CollateX
=cut
sub alignment_table {
- my( $self ) = @_;
- return $self->cached_table if $self->has_cached_table;
+ my( $self, $opts ) = @_;
+ return $self->cached_table
+ if $self->has_cached_table && !$opts->{noac};
# Make sure we can do this
throw( "Need a linear graph in order to make an alignment table" )
my $witobj = { 'witness' => $wit->sigil, 'tokens' => \@row };
$witobj->{'identifier'} = $wit->identifier if $wit->identifier;
push( @{$table->{'alignment'}}, $witobj );
- if( $wit->is_layered ) {
+ if( $wit->is_layered && !$opts->{noac} ) {
my @wit_ac_path = $self->reading_sequence( $self->start, $self->end,
$wit->sigil.$self->ac_label );
my @ac_row = _make_witness_row( \@wit_ac_path, \@all_pos );
projects / scpubgit/stemmatology.git / blobdiff