Rosetta Code

Autogram checker: Difference between revisions

Page Discussion

Autogram checker (view source)

Revision as of 04:27, 19 July 2022

221 bytes removed ,  1 year ago
m
→‎{{header|Perl}}: various simplifications
m (→‎{{header|Perl}}: various simplifications)
Line 216:
<lang perl>use v5.36;
use experimental <builtin for_list>;
 
use Sub::Util 'subname';
use List::Util 'sum';
use Text::Wrap;
$Text::Wrap::columns = 101;
 
my %nums = (
Line 229 ⟶ 226:
'ninety' => 90, 'hundred' => 100,
);
 
sub whitespace ($text) { $text =~ s/\s/ /gr }▼
sub punctuation ($text) { $text =~ s/\W//grx }
 
my @tests = (
\&punctuation, "This sentence employs two a's, two c's, two d's, twenty-eight e's, five f's, three g's, eight h's, eleven i's, three l's, two m's, thirteen n's, nine o's, two p's, five r's, twenty-five s's, twenty-three t's, six v's, ten w's, two x's, five y's, and one z.",
\&punctuation, "This sentence employs two a's, two c's, two d's, twenty eight e's, five f's, three g's, eight h's, eleven i's, three l's, two m's, thirteen n's, nine o's, two p's, five r's, twenty five s's, twenty three t's, six v's, ten w's, two x's, five y's, and one z.",
\&whitespace'', "Only the fool would take trouble to verify that his sentence was composed of ten a's, three b's, four c's, four d's, forty-six e's, sixteen f's, four g's, thirteen h's, fifteen i's, two k's, nine l's, four m's, twenty-five n's, twenty-four o's, five p's, sixteen r's, forty-one s's, thirty-seven t's, ten u's, eight v's, eight w's, four x's, eleven y's, twenty-seven commas, twenty-three apostrophes, seven hyphens and, last but not least, a single !",
\&punctuation, "This pangram contains four as, one b, two cs, one d, thirty es, six fs, five gs, seven hs, eleven is, one j, one k, two ls, two ms, eighteen ns, fifteen os, two ps, one q, five rs, twenty-seven ss, eighteen ts, two us, seven vs, eight ws, two xs, three ys, & one z.",
\&punctuation, "This sentence contains one hundred and ninety-seven letters: four a's, one b, three c's, five d's, thirty-four e's, seven f's, one g, six h's, twelve i's, three l's, twenty-six n's, ten o's, ten r's, twenty-nine s's, nineteen t's, six u's, seven v's, four w's, four x's, five y's, and one z.",
\&punctuation, "Thirteen e's, five f's, two g's, five h's, eight i's, two l's, three n's, six o's, six r's, twenty s's, twelve t's, three u's, four v's, six w's, four x's, two y's.",
\&whitespace'', "Fifteen e's, seven f's, four g's, six h's, eight i's, four n's, five o's, six r's, eighteen s's, eight t's, four u's, three v's, two w's, three x's.",
\&punctuation, "Sixteen e's, five f's, three g's, six h's, nine i's, five n's, four o's, six r's, eighteen s's, eight t's, three u's, three v's, two w's, four z's."
);
 
▲sub whitespace punctuation ($text) { $text =~ s/\sW/ /grgrx }
say '=' x 101;
sub wrap { (shift) =~ s/(.{96}.*?\s)/$1\n/gr }
 
for my($filter, $text) (@tests) {
my(%Claim, %Actual, $count_claim, $count_actual);
my %Punc = ('apostrophe' => "'", 'hyphen' => '-', 'comma' => ',', 'exclamation' => '!');
my $str = my $origfiltered = my $original = lc $text;
$str =~ s/\!/exclamation/g;▼
 
say wrap('', '', $text);
my $filter_namefilter_func = $filter ? subname( $filter ) =~ s/main:://r : '';
say "\nFilteringnNOT filtering out $filter_namepunctuation" ifunless $filter_name eq 'punctuation'filter_func;
 
▲ $str =~ s/\!/exclamation/g;
$str =~ s/\bone ([a-z])[,.]\b/one $1's,/g;
for my($word, $number) (%nums) { $str =~ s/ \b $word \b /$number/gxgix }
$str =~ s/(\d0)[ \-](\d)/$1 + $2/gxe;
$str =~ s/\b1 100 and (\d+)\b/100 + $1/e;
$str =~ s/(\d+) ([a-z])['?s,.]*\b/ $Claim{$2} = $1/ge;
$str =~ s/and (\d+) ([a-z])/$Claim{$2}= $1/e;
 
my $filtered = &$filter($origoriginal) if $filter;
$Actual{$_} = () = $filtered =~ /$_/g for keys %Claim;
$count_claim .= "$_($Claim{$_}) " for sort keys %Claim;
$count_actual .= "$_($Actual{$_}) " for sort keys %Actual;
 
ifunless ($filter_name ne 'punctuation'filter_func) {
for (sort keys %PuncPunctuation) {
$str =~ m/(\d+) ($_)/;
$count_claim .= "$PuncPunctuation{$2}($1) " if $1 and $PuncPunctuation{$2};
my $n = () = $filtered =~ /\Q$PuncPunctuation{$_}/g;
$count_actual .= "$PuncPunctuation{$_}($n) " if $n;
}
}
 
say "\nClaimed character counts:\n" . wrap('', '', $count_claim );
say "\nActual character counts:\n" . wrap('','', $count_actual);
 
say "\nAutogram? ". (my $AG = $count_claim eq $count_actual ? 'True' : 'False');
Line 284 ⟶ 278:
if $str =~ /(\d+) letters/;
say "\n" . '=' x 101;
}</lang>▼
}
▲</lang>
{{out}}
<pre style="height:60ex">This sentence employs two a's, two c's, two d's, twenty-eight e's, five f's, three g's, eight h's,▼
<pre style="height:60ex">=====================================================================================================
▲This sentence employs two a's, two c's, two d's, twenty-eight e's, five f's, three g's, eight h's,
eleven i's, three l's, two m's, thirteen n's, nine o's, two p's, five r's, twenty-five s's,
twenty-three t's, six v's, ten w's, two x's, five y's, and one z.
 
Filtering out punctuation▼
 
Claimed character counts:
Line 308 ⟶ 298:
eleven i's, three l's, two m's, thirteen n's, nine o's, two p's, five r's, twenty five s's, twenty
three t's, six v's, ten w's, two x's, five y's, and one z.
 
Filtering out punctuation▼
 
Claimed character counts:
Line 325 ⟶ 313:
eleven i's, three l's, two m's, thirteen n's, nine o's, two p's, five r's, twenty five s's, twenty
three t's, six v's, ten w's, two x's, five y's, and one z.
 
Filtering out punctuation
 
Claimed character counts:
Line 344 ⟶ 330:
t's, ten u's, eight v's, eight w's, four x's, eleven y's, twenty-seven commas, twenty-three
apostrophes, seven hyphens and, last but not least, a single !
 
▲FilteringNOT filtering out punctuation
 
Claimed character counts:
Line 359 ⟶ 347:
is, one j, one k, two ls, two ms, eighteen ns, fifteen os, two ps, one q, five rs, twenty-seven ss,
eighteen ts, two us, seven vs, eight ws, two xs, three ys, & one z.
 
Filtering out punctuation
 
Claimed character counts:
a(4) b(1) c(2) d(1) e(30) f(6) g(5) h(7) i(11) j(1) k(1) l(2) m(2) n(18) o(15) p(2) q(1) r(5) s(27) t(18) u(2) v(7) w(8) x(2)
t(18) u(2) v(7) w(8) x(2) y(3) z(1)
y(3)
 
Actual character counts:
a(4) b(1) c(2) d(1) e(30) f(6) g(5) h(7) i(11) j(1) k(1) l(2) m(2) n(18) o(15) p(2) q(1) r(5) s(27) t(18) u(2) v(7) w(8) x(2)
t(18) u(2) v(7) w(8) x(2) y(3) z(1)
y(3)
 
Autogram? True
Line 376 ⟶ 362:
thirty-four e's, seven f's, one g, six h's, twelve i's, three l's, twenty-six n's, ten o's, ten r's,
twenty-nine s's, nineteen t's, six u's, seven v's, four w's, four x's, five y's, and one z.
 
Filtering out punctuation
 
Claimed character counts:
a(4) b(1) c(3) d(5) e(34) f(7) g(1) h(6) i(12) l(3) n(26) o(10) r(10) s(29) t(19) u(6) v(7) w(4) x(4) y(5)
x(4) y(5) z(1)
 
Actual character counts:
a(4) b(1) c(3) d(5) e(34) f(7) g(1) h(6) i(12) l(3) n(26) o(10) r(10) s(29) t(19) u(6) v(7) w(4) x(4) y(5)
x(4) y(5) z(1)
 
Autogram? True
Line 393 ⟶ 377:
Thirteen e's, five f's, two g's, five h's, eight i's, two l's, three n's, six o's, six r's, twenty
s's, twelve t's, three u's, four v's, six w's, four x's, two y's.
 
Filtering out punctuation
 
Claimed character counts:
Line 407 ⟶ 389:
Fifteen e's, seven f's, four g's, six h's, eight i's, four n's, five o's, six r's, eighteen s's,
eight t's, four u's, three v's, two w's, three x's.
 
▲FilteringNOT filtering out punctuation
 
Claimed character counts:
Line 419 ⟶ 403:
Sixteen e's, five f's, three g's, six h's, nine i's, five n's, four o's, six r's, eighteen s's,
eight t's, three u's, three v's, two w's, four z's.
 
Filtering out punctuation
 
Claimed character counts:
SqrtNegInf
2,392

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/321279"