10 use Text::Tradition::Analysis qw/ group_variants /;
11 use Text::Tradition::Directory;
14 binmode STDOUT, ':utf8';
15 binmode STDERR, ':utf8';
17 my( $dsn, $dbuser, $dbpass );
18 my $filename = 'magnitude.csv';
21 'u|user=s' => \$dbuser,
22 'p|pass=s' => \$dbpass,
23 'f|file=s' => \$filename
26 my %dbopts = ( dsn => $dsn );
27 if( $dbuser || $dbpass ) {
28 $dbopts{extra_args} = { user => $dbuser, password => $dbpass }
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();
36 say "Merging relationship types @ARGV";
37 map { $collapse->insert($_) } @ARGV;
40 my $csv = Text::CSV_XS->new( { binary => 1, quote_null => 0 } );
41 open my $fh, ">:encoding(UTF-8)", $filename or die "$filename: $!";
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/;
48 next unless $tinfo->{'id'} eq $lookfor
49 || $tinfo->{'name'} =~ /$lookfor/;
51 my $tradition = $dir->lookup( $tinfo->{'id'} );
52 say "Counting variation in tradition " . $tradition->name;
54 # Group the variants for each rank, and count the number of
56 my $lcph = Set::Scalar->new(); # placeholder for lacunae
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} ) {
69 $magnitudes{$numr} = 1;
73 # Write them out to CSV.
74 my @csvalues = map { $magnitudes{$_} || 0 } 2..$max;
75 if( $csv->combine( $tradition->name, @csvalues ) ) {
78 say "combine() failed on argument: " . $csv->error_input;