Commit | Line | Data |
3bce8f64 |
1 | #!/usr/bin/env perl |
2 | |
3 | use feature 'say'; |
4 | use lib 'lib'; |
5 | use strict; |
6 | use warnings; |
7 | use Getopt::Long; |
8 | use Set::Scalar; |
9 | use Text::CSV_XS; |
10 | use Text::Tradition::Analysis qw/ group_variants /; |
11 | use Text::Tradition::Directory; |
12 | use TryCatch; |
13 | |
14 | binmode STDOUT, ':utf8'; |
15 | binmode STDERR, ':utf8'; |
16 | |
17 | my( $dsn, $dbuser, $dbpass ); |
18 | my $filename = 'magnitude.csv'; |
19 | GetOptions( |
20 | 'dsn=s' => \$dsn, |
21 | 'u|user=s' => \$dbuser, |
22 | 'p|pass=s' => \$dbpass, |
23 | 'f|file=s' => \$filename |
24 | ); |
25 | |
26 | my %dbopts = ( dsn => $dsn ); |
27 | if( $dbuser || $dbpass ) { |
28 | $dbopts{extra_args} = { user => $dbuser, password => $dbpass } |
29 | } |
30 | |
31 | my $dir = Text::Tradition::Directory->new( %dbopts ); |
32 | my $scope = $dir->new_scope(); |
33 | my $lookfor = shift @ARGV || ''; |
34 | my $collapse = Set::Scalar->new(); |
35 | if( @ARGV ) { |
36 | say "Merging relationship types @ARGV"; |
37 | map { $collapse->insert($_) } @ARGV; |
38 | } |
39 | |
40 | my $csv = Text::CSV_XS->new( { binary => 1, quote_null => 0 } ); |
41 | open my $fh, ">:encoding(UTF-8)", $filename or die "$filename: $!"; |
42 | |
43 | foreach my $tinfo( $dir->traditionlist ) { |
44 | next if $tinfo->{'name'} eq 'xxxxx'; |
45 | next if $tinfo->{'name'} =~ /158/; |
46 | next if $tinfo->{'name'} =~ /Heinrichi part/; |
47 | if( $lookfor ) { |
48 | next unless $tinfo->{'id'} eq $lookfor |
49 | || $tinfo->{'name'} =~ /$lookfor/; |
50 | } |
51 | my $tradition = $dir->lookup( $tinfo->{'id'} ); |
52 | say "Counting variation in tradition " . $tradition->name; |
53 | |
54 | # Group the variants for each rank, and count the number of |
55 | # reading groupings. |
56 | my $lcph = Set::Scalar->new(); # placeholder for lacunae |
57 | my $moved = {}; |
58 | my %magnitudes; |
59 | my $max = 1; |
60 | foreach my $rk ( 1 .. $tradition->collation->end->rank ) { |
61 | my $missing = $lcph->clone(); |
62 | my $rankgroup = group_variants( $tradition, $rk, $missing, $moved, $collapse ); |
63 | my $numr = scalar keys %$rankgroup; |
64 | $numr++ if $missing->size; |
65 | $max = $numr if $numr > $max; |
66 | if( exists $magnitudes{$numr} ) { |
67 | $magnitudes{$numr}++ |
68 | } else { |
69 | $magnitudes{$numr} = 1; |
70 | } |
71 | } |
72 | |
73 | # Write them out to CSV. |
74 | my @csvalues = map { $magnitudes{$_} || 0 } 2..$max; |
75 | if( $csv->combine( $tradition->name, @csvalues ) ) { |
76 | say $fh $csv->string; |
77 | } else { |
78 | say "combine() failed on argument: " . $csv->error_input; |
79 | } |
80 | } |
81 | |
82 | close $fh; |