Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re: Counting words

by johngg (Canon)
on Nov 05, 2017 at 11:40 UTC ( [id://1202773]=note: print w/replies, xml ) Need Help??


in reply to Counting words

As long as you are not allowing overlaps, an alternative to toolic's regex solution would be to use unpack.

johngg@shiraz:~/perl/Monks > perl -Mstrict -Mwarnings -E ' my $str = q{BEBEBEHUHUHUJJFAFALL}; my %cnt; $cnt{ $_ } ++ for unpack q{(a2)*}, $str; say qq{$_ -> $cnt{ $_ }} for sort keys %cnt;' BE -> 3 FA -> 2 HU -> 3 JJ -> 1 LL -> 1

I hope this is of interest.

Update: A bit of a lash-up allowing for overlaps.

johngg@shiraz:~/perl/Monks > perl -Mstrict -Mwarnings -E ' my $str = q{BEBEBEHUHUHUJJFAFALL}; my %cnt; my $len = shift || 2; my $overlap = shift || 0; my $fmt = $overlap ? qq{(a${len}X@{ [ $len - 1 ] })*} : qq{(a${len})*}; $cnt{ $_ } ++ for grep { length == $len } unpack $fmt, $str; say qq{$_ -> $cnt{ $_ }} for sort keys %cnt;' BE -> 3 FA -> 2 HU -> 3 JJ -> 1 LL -> 1 johngg@shiraz:~/perl/Monks > perl -Mstrict -Mwarnings -E ' my $str = q{BEBEBEHUHUHUJJFAFALL}; my %cnt; my $len = shift || 2; my $overlap = shift || 0; my $fmt = $overlap ? qq{(a${len}X@{ [ $len - 1 ] })*} : qq{(a${len})*}; $cnt{ $_ } ++ for grep { length == $len } unpack $fmt, $str; say qq{$_ -> $cnt{ $_ }} for sort keys %cnt;' 2 1 AF -> 1 AL -> 1 BE -> 3 EB -> 2 EH -> 1 FA -> 2 HU -> 3 JF -> 1 JJ -> 1 LL -> 1 UH -> 2 UJ -> 1 johngg@shiraz:~/perl/Monks > perl -Mstrict -Mwarnings -E ' my $str = q{BEBEBEHUHUHUJJFAFALL}; my %cnt; my $len = shift || 2; my $overlap = shift || 0; my $fmt = $overlap ? qq{(a${len}X@{ [ $len - 1 ] })*} : qq{(a${len})*}; $cnt{ $_ } ++ for grep { length == $len } unpack $fmt, $str; say qq{$_ -> $cnt{ $_ }} for sort keys %cnt;' 3 AFA -> 1 BEB -> 1 EBE -> 1 HUH -> 1 JJF -> 1 UHU -> 1 johngg@shiraz:~/perl/Monks > perl -Mstrict -Mwarnings -E ' my $str = q{BEBEBEHUHUHUJJFAFALL}; my %cnt; my $len = shift || 2; my $overlap = shift || 0; my $fmt = $overlap ? qq{(a${len}X@{ [ $len - 1 ] })*} : qq{(a${len})*}; $cnt{ $_ } ++ for grep { length == $len } unpack $fmt, $str; say qq{$_ -> $cnt{ $_ }} for sort keys %cnt;' 3 1 AFA -> 1 ALL -> 1 BEB -> 2 BEH -> 1 EBE -> 2 EHU -> 1 FAF -> 1 FAL -> 1 HUH -> 2 HUJ -> 1 JFA -> 1 JJF -> 1 UHU -> 2 UJJ -> 1

Cheers,

JohnGG

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1202773]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2024-04-19 03:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found