Add check for duplicate_reading that at least one witness remains for each reading...
[scpubgit/stemmatology.git] / base / t / text_tradition_collation.t
CommitLineData
0e47f4f6 1#!/usr/bin/perl -w
2
3use strict;
4use Test::More 'no_plan';
5$| = 1;
6
7
8
9# =begin testing
10{
11use Text::Tradition;
12
4e483aa5 13my $cxfile = 't/data/Collatex-16.xml';
14my $t = Text::Tradition->new(
15 'name' => 'inline',
16 'input' => 'CollateX',
17 'file' => $cxfile,
18 );
19my $c = $t->collation;
20
21my $rno = scalar $c->readings;
3c234eb6 22# Split n21 ('unto') for testing purposes
4e483aa5 23my $new_r = $c->add_reading( { 'id' => 'n21p0', 'text' => 'un', 'join_next' => 1 } );
24my $old_r = $c->reading( 'n21' );
25$old_r->alter_text( 'to' );
26$c->del_path( 'n20', 'n21', 'A' );
27$c->add_path( 'n20', 'n21p0', 'A' );
28$c->add_path( 'n21p0', 'n21', 'A' );
7a0956c1 29$c->add_relationship( 'n21', 'n22', { type => 'collated', scope => 'local' } );
4e483aa5 30$c->flatten_ranks();
31ok( $c->reading( 'n21p0' ), "New reading exists" );
32is( scalar $c->readings, $rno, "Reading add offset by flatten_ranks" );
33
679f17e1 34# Combine n3 and n4 ( with his )
4e483aa5 35$c->merge_readings( 'n3', 'n4', 1 );
36ok( !$c->reading('n4'), "Reading n4 is gone" );
37is( $c->reading('n3')->text, 'with his', "Reading n3 has both words" );
38
679f17e1 39# Collapse n9 and n10 ( rood / root )
40$c->merge_readings( 'n9', 'n10' );
41ok( !$c->reading('n10'), "Reading n10 is gone" );
42is( $c->reading('n9')->text, 'rood', "Reading n9 has an unchanged word" );
4e483aa5 43
44# Combine n21 and n21p0
45my $remaining = $c->reading('n21');
46$remaining ||= $c->reading('n22'); # one of these should still exist
47$c->merge_readings( 'n21p0', $remaining, 1 );
48ok( !$c->reading('n21'), "Reading $remaining is gone" );
49is( $c->reading('n21p0')->text, 'unto', "Reading n21p0 merged correctly" );
50}
51
52
53
54# =begin testing
55{
68e48c06 56use Test::More::UTF8;
4e483aa5 57use Text::Tradition;
68e48c06 58use TryCatch;
f97ef19e 59
60my $st = Text::Tradition->new( 'input' => 'Self', 'file' => 't/data/collatecorr.xml' );
61is( ref( $st ), 'Text::Tradition', "Got a tradition from test file" );
62ok( $st->has_witness('Ba96'), "Tradition has the affected witness" );
63
64my $sc = $st->collation;
65my $numr = 17;
66ok( $sc->reading('n131'), "Tradition has the affected reading" );
67is( scalar( $sc->readings ), $numr, "There are $numr readings in the graph" );
68is( $sc->end->rank, 14, "There are fourteen ranks in the graph" );
69
70# Detach the erroneously collated reading
2dcb5d11 71my( $newr, @del_rdgs ) = $sc->duplicate_reading( 'n131', 'Ba96' );
ef73c20a 72ok( $newr, "New reading was created" );
f97ef19e 73ok( $sc->reading('n131_0'), "Detached the bad collation with a new reading" );
74is( scalar( $sc->readings ), $numr + 1, "A reading was added to the graph" );
75is( $sc->end->rank, 10, "There are now only ten ranks in the graph" );
3c234eb6 76my $csucc = $sc->common_successor( 'n131', 'n131_0' );
77is( $csucc->id, 'n136', "Found correct common successor to duped reading" );
f97ef19e 78
79# Check that the bad transposition is gone
2dcb5d11 80is( scalar @del_rdgs, 1, "Deleted reading was returned by API call" );
f97ef19e 81is( $sc->get_relationship( 'n130', 'n135' ), undef, "Bad transposition relationship is gone" );
82
e19635f8 83# The collation should not be fixed
84my @pairs = $sc->identical_readings();
85is( scalar @pairs, 0, "Not re-collated yet" );
f97ef19e 86# Fix the collation
3c234eb6 87ok( $sc->merge_readings( 'n124', 'n131_0' ), "Collated the readings correctly" );
e19635f8 88@pairs = $sc->identical_readings( start => 'n124', end => $csucc->id );
3c234eb6 89is( scalar @pairs, 3, "Found three more identical readings" );
e19635f8 90is( $sc->end->rank, 11, "The ranks shifted appropriately" );
3c234eb6 91$sc->flatten_ranks();
f97ef19e 92is( scalar( $sc->readings ), $numr - 3, "Now we are collated correctly" );
68e48c06 93
94# Check that we can't "duplicate" a reading with no wits or with all wits
95try {
96 my( $badr, @del_rdgs ) = $sc->duplicate_reading( 'n124' );
97 ok( 0, "Reading duplication without witnesses throws an error" );
98} catch( Text::Tradition::Error $e ) {
99 like( $e->message, qr/Must specify one or more witnesses/,
100 "Reading duplication without witnesses throws the expected error" );
101} catch {
102 ok( 0, "Reading duplication without witnesses threw the wrong error" );
103}
104
105try {
106 my( $badr, @del_rdgs ) = $sc->duplicate_reading( 'n124', 'Ba96', 'Mü11475' );
107 ok( 0, "Reading duplication with all witnesses throws an error" );
108} catch( Text::Tradition::Error $e ) {
109 like( $e->message, qr/Cannot join all witnesses/,
110 "Reading duplication with all witnesses throws the expected error" );
111} catch {
112 ok( 0, "Reading duplication with all witnesses threw the wrong error" );
113}
f97ef19e 114}
115
116
117
118# =begin testing
119{
120use Text::Tradition;
951ddfe8 121use TryCatch;
4e483aa5 122
56eefa04 123my $READINGS = 311;
124my $PATHS = 361;
125
126my $datafile = 't/data/florilegium_tei_ps.xml';
127my $tradition = Text::Tradition->new( 'input' => 'TEI',
128 'name' => 'test0',
129 'file' => $datafile,
130 'linear' => 1 );
131
132ok( $tradition, "Got a tradition object" );
133is( scalar $tradition->witnesses, 13, "Found all witnesses" );
134ok( $tradition->collation, "Tradition has a collation" );
135
136my $c = $tradition->collation;
137is( scalar $c->readings, $READINGS, "Collation has all readings" );
138is( scalar $c->paths, $PATHS, "Collation has all paths" );
139is( scalar $c->relationships, 0, "Collation has all relationships" );
140
141# Add a few relationships
142$c->add_relationship( 'w123', 'w125', { 'type' => 'collated' } );
143$c->add_relationship( 'w193', 'w196', { 'type' => 'collated' } );
144$c->add_relationship( 'w257', 'w262', { 'type' => 'transposition' } );
145
146# Now write it to GraphML and parse it again.
147
148my $graphml = $c->as_graphml;
149my $st = Text::Tradition->new( 'input' => 'Self', 'string' => $graphml );
150is( scalar $st->collation->readings, $READINGS, "Reparsed collation has all readings" );
151is( scalar $st->collation->paths, $PATHS, "Reparsed collation has all paths" );
152is( scalar $st->collation->relationships, 3, "Reparsed collation has new relationships" );
2a812726 153
9fef629b 154# Now add a stemma, write to GraphML, and look at the output.
951ddfe8 155SKIP: {
37bf09f4 156 skip "Analysis module not present", 3 unless $tradition->can( 'add_stemma' );
951ddfe8 157 my $stemma = $tradition->add_stemma( 'dotfile' => 't/data/florilegium.dot' );
158 is( ref( $stemma ), 'Text::Tradition::Stemma', "Parsed dotfile into stemma" );
159 is( $tradition->stemmata, 1, "Tradition now has the stemma" );
160 $graphml = $c->as_graphml;
161 like( $graphml, qr/digraph/, "Digraph declaration exists in GraphML" );
162}
56eefa04 163}
164
165
166
167# =begin testing
168{
16203db5 169use Text::Tradition;
34ca808b 170use Text::CSV;
16203db5 171
172my $READINGS = 311;
173my $PATHS = 361;
34ca808b 174my $WITS = 13;
175my $WITAC = 4;
16203db5 176
177my $datafile = 't/data/florilegium_tei_ps.xml';
178my $tradition = Text::Tradition->new( 'input' => 'TEI',
179 'name' => 'test0',
180 'file' => $datafile,
181 'linear' => 1 );
182
183my $c = $tradition->collation;
184# Export the thing to CSV
185my $csvstr = $c->as_csv();
34ca808b 186# Count the columns
187my $csv = Text::CSV->new({ sep_char => ',', binary => 1 });
188my @lines = split(/\n/, $csvstr );
189ok( $csv->parse( $lines[0] ), "Successfully parsed first line of CSV" );
190is( scalar( $csv->fields ), $WITS + $WITAC, "CSV has correct number of witness columns" );
cbc8e08f 191my @q_ac = grep { $_ eq 'Q'.$c->ac_label } $csv->fields;
192ok( @q_ac, "Found a layered witness" );
193
16203db5 194my $t2 = Text::Tradition->new( input => 'Tabular',
195 name => 'test2',
196 string => $csvstr,
197 sep_char => ',' );
198is( scalar $t2->collation->readings, $READINGS, "Reparsed CSV collation has all readings" );
199is( scalar $t2->collation->paths, $PATHS, "Reparsed CSV collation has all paths" );
200
201# Now do it with TSV
202my $tsvstr = $c->as_tsv();
203my $t3 = Text::Tradition->new( input => 'Tabular',
204 name => 'test3',
205 string => $tsvstr,
206 sep_char => "\t" );
207is( scalar $t3->collation->readings, $READINGS, "Reparsed TSV collation has all readings" );
208is( scalar $t3->collation->paths, $PATHS, "Reparsed TSV collation has all paths" );
34ca808b 209
4e64b669 210my $table = $c->alignment_table;
34ca808b 211my $noaccsv = $c->as_csv({ noac => 1 });
212my @noaclines = split(/\n/, $noaccsv );
213ok( $csv->parse( $noaclines[0] ), "Successfully parsed first line of no-ac CSV" );
214is( scalar( $csv->fields ), $WITS, "CSV has correct number of witness columns" );
4e64b669 215is( $c->alignment_table, $table, "Request for CSV did not alter the alignment table" );
cbc8e08f 216
217my $safecsv = $c->as_csv({ safe_ac => 1});
218my @safelines = split(/\n/, $safecsv );
219ok( $csv->parse( $safelines[0] ), "Successfully parsed first line of safe CSV" );
220is( scalar( $csv->fields ), $WITS + $WITAC, "CSV has correct number of witness columns" );
221@q_ac = grep { $_ eq 'Q__L' } $csv->fields;
222ok( @q_ac, "Found a sanitized layered witness" );
223is( $c->alignment_table, $table, "Request for CSV did not alter the alignment table" );
16203db5 224}
225
226
227
228# =begin testing
229{
56eefa04 230use Text::Tradition;
231
0e47f4f6 232my $cxfile = 't/data/Collatex-16.xml';
233my $t = Text::Tradition->new(
234 'name' => 'inline',
235 'input' => 'CollateX',
236 'file' => $cxfile,
237 );
238my $c = $t->collation;
4633f9e4 239
b365fbae 240# Make an svg
bfcbcecb 241my $table = $c->alignment_table;
242ok( $c->has_cached_table, "Alignment table was cached" );
243is( $c->alignment_table, $table, "Cached table returned upon second call" );
b365fbae 244$c->calculate_ranks;
bfcbcecb 245is( $c->alignment_table, $table, "Cached table retained with no rank change" );
864ee4bf 246$c->add_relationship( 'n13', 'n23', { type => 'repetition' } );
247is( $c->alignment_table, $table, "Alignment table unchanged after non-colo relationship add" );
248$c->add_relationship( 'n24', 'n23', { type => 'spelling' } );
249isnt( $c->alignment_table, $table, "Alignment table changed after colo relationship add" );
b365fbae 250}
251
252
253
254# =begin testing
255{
256use Text::Tradition;
257
258my $cxfile = 't/data/Collatex-16.xml';
259my $t = Text::Tradition->new(
260 'name' => 'inline',
261 'input' => 'CollateX',
262 'file' => $cxfile,
263 );
264my $c = $t->collation;
0e47f4f6 265
d4b75f44 266my @common = $c->calculate_common_readings();
267is( scalar @common, 8, "Found correct number of common readings" );
268my @marked = sort $c->common_readings();
269is( scalar @common, 8, "All common readings got marked as such" );
679f17e1 270my @expected = qw/ n1 n11 n16 n19 n20 n5 n6 n7 /;
d4b75f44 271is_deeply( \@marked, \@expected, "Found correct list of common readings" );
272}
273
274
275
276# =begin testing
277{
278use Text::Tradition;
279
280my $cxfile = 't/data/Collatex-16.xml';
281my $t = Text::Tradition->new(
282 'name' => 'inline',
283 'input' => 'CollateX',
284 'file' => $cxfile,
285 );
286my $c = $t->collation;
287
679f17e1 288is( $c->common_predecessor( 'n24', 'n23' )->id,
0e47f4f6 289 'n20', "Found correct common predecessor" );
679f17e1 290is( $c->common_successor( 'n24', 'n23' )->id,
10e4b1ac 291 '__END__', "Found correct common successor" );
0e47f4f6 292
4e5a7b2c 293is( $c->common_predecessor( 'n19', 'n17' )->id,
0e47f4f6 294 'n16', "Found correct common predecessor for readings on same path" );
679f17e1 295is( $c->common_successor( 'n21', 'n10' )->id,
10e4b1ac 296 '__END__', "Found correct common successor for readings on same path" );
0e47f4f6 297}
298
299
300
301
3021;