Sorensen–Dice coefficient: Difference between revisions
Added Perl
m (→{{header|J}}: grammar) |
SqrtNegInf (talk | contribs) (Added Perl) |
||
Line 201:
0.608696 Fermat numbers
0.600000 Lah numbers </pre>
=={{header|Perl}}==
<syntaxhighlight lang="perl" line>use v5.036;
use Path::Tiny;
use List::Util <uniq head>;
sub bi_gram {
my $line = lc shift;
uniq map { substr $line,$_,2 } 0..length($line)-2;
}
sub score {
my($phrase, $word) = @_;
my %count;
my @match = bi_gram $phrase;
$count{$_}++ for @match, @$word;
2 * (grep { $count{$_} > 1 } keys %count) / (@match + @$word);
}
sub sorensen {
my($dict,$word,$cutoff) = @_; $cutoff //= 0.00;
my(%matches,$s);
($s = score($word, $$dict{$_})) > $cutoff and $matches{$_} = $s for keys %$dict;
%matches;
}
my %dict = map { $_ => [ bi_gram($_) ] } path('ref/Sorensen-Dice-Tasks.txt')->slurp =~ /.{10,}/gm;
for my $word ( ('Primordial primes', 'Sunkist-Giuliani formula', 'Sieve of Euripides', 'Chowder numbers') ) {
my(%scored,@ranked);
%scored = sorensen(\%dict,$word);
push @ranked, sprintf "%.3f $_", $scored{$_} for sort { $scored{$b} <=> $scored{$a} || $a cmp $b } keys %scored;
say "\n$word:\n" . join("\n", head 5, @ranked);
}</syntaxhighlight>
{{out}}
<pre>Primordial primes:
0.741 Factorial primes
0.629 Sequence of primorial primes
0.583 Almost prime
0.581 Next special primes
0.571 Pandigital prime
Sunkist-Giuliani formula:
0.542 Almkvist-Giullera formula for pi
0.368 Haversine formula
0.359 Faulhaber's formula
0.348 Check Machin-like formulas
0.303 FASTA format
Sieve of Euripides:
0.541 Sieve of Eratosthenes
0.529 Sieve of Pritchard
0.457 Four sides of square
0.457 The sieve of Sundaram
0.387 Sum of a series
Chowder numbers:
0.769 Chowla numbers
0.615 Rhonda numbers
0.609 Bell numbers
0.609 Lah numbers
0.593 Kaprekar numbers</pre>
=={{header|Phix}}==
| |||