Perlを使用して、ファイル内の文字、単語、行を数えるにはどうすればよいですか？
Perlを使用して（wcを使用せずに）テキストファイルの文字、単語、および行の数を数えるための良い/最良の方法は何ですか？
これがPerlコードです。単語を数えることは多少主観的ですが、空白ではない文字列であると私は言います。
open(FILE, "<file.txt") or die "Could not open file: $!";
my ($lines, $words, $chars) = (0,0,0);
while (<FILE>) {
$lines++;
$chars += length($_);
$words += scalar(split(/\s+/, $_));
}
print("lines=$lines words=$words chars=$chars\n");
おそらくより良い結果を生み出すbmdhacksの答えのバリエーションは、区切り文字として\ s +（またはさらに良い\ W +）を使用することです。文字列「Thequickbrown fox」（わかりにくい場合は追加のスペース）について考えてみます。単一の空白文字の区切り文字を使用すると、単語数は4ではなく6になります。だから、試してみてください：
open(FILE, "<file.txt") or die "Could not open file: $!";
my ($lines, $words, $chars) = (0,0,0);
while (<FILE>) {
$lines++;
$chars += length($_);
$words += scalar(split(/\W+/, $_));
}
print("lines=$lines words=$words chars=$chars\n");
区切り文字として\ W +を使用すると、句読点（特に）が単語としてカウントされなくなります。
ワードカウントツール テキストファイル内の文字、単語、行をカウントします
ここに。このUnicodeに精通したバージョンのwcプログラムを試してください。
ファイル以外の引数（パイプ、ディレクトリ、ソケットなど）をスキップします。
UTF-8テキストを想定しています。
Unicodeの空白をWordの区切り文字としてカウントします。
また、ファイル名の末尾に
.ENCODING、foo.cp1252、foo.latin1など、foo.utf16がある場合は、代替エンコーディングも受け入れます。また、さまざまな形式で圧縮されたファイルでも機能します。
段落、行、単語、書記素、文字、およびバイトの数を示します。
すべてのUnicode改行シーケンスを理解します。
改行エラーのある破損したテキストファイルについて警告します。
これを実行する例を次に示します。
Paras Lines Words Graphs Chars Bytes File
2 2270 82249 504169 504333 528663 /tmp/ap
1 2404 11163 63164 63164 66336 /tmp/b3
uwc: missing linebreak at end of corrupted textfiile /tmp/bad
1* 2* 4 19 19 19 /tmp/bad
1 14 52 273 273 293 /tmp/es
57 383 1369 11997 11997 12001 /tmp/funny
1 657068 3175429 31205970 31209138 32633834 /tmp/lw
1 1 4 27 27 27 /tmp/nf.cp1252
1 1 4 27 27 34 /tmp/nf.euc-jp
1 1 4 27 27 27 /tmp/nf.latin1
1 1 4 27 27 27 /tmp/nf.macroman
1 1 4 27 27 54 /tmp/nf.ucs2
1 1 4 27 27 56 /tmp/nf.utf16
1 1 4 27 27 54 /tmp/nf.utf16be
1 1 4 27 27 54 /tmp/nf.utf16le
1 1 4 27 27 112 /tmp/nf.utf32
1 1 4 27 27 108 /tmp/nf.utf32be
1 1 4 27 27 108 /tmp/nf.utf32le
1 1 4 27 27 39 /tmp/nf.utf7
1 1 4 27 27 31 /tmp/nf.utf8
1 26906 101528 635841 636026 661202 /tmp/o2
131 346 1370 9590 9590 4486 /tmp/Perl5122delta.pod.gz
291 814 3941 25318 25318 9878 /tmp/Perl51310delta.pod.bz2
1 2551 5345 132655 132655 133178 /tmp/tailsort-pl.utf8
1 89 334 1784 1784 2094 /tmp/til
1 4 18 88 88 106 /tmp/w
276 1736 5773 53782 53782 53804 /tmp/www
ここに行きます：
#!/usr/bin/env Perl
#########################################################################
# uniwc - improved version of wc that works correctly with Unicode
#
# Tom Christiansen <[email protected]>
# Mon Feb 28 15:59:01 MST 2011
#########################################################################
use 5.10.0;
use strict;
use warnings FATAL => "all";
use sigtrap qw[ die untrapped normal-signals ];
use Carp;
$SIG{__WARN__} = sub {
confess("FATALIZED WARNING: @_") unless $^S;
};
$SIG{__DIE__} = sub {
confess("UNCAUGHT EXCEPTION: @_") unless $^S;
};
$| = 1;
my $Errors = 0;
my $Headers = 0;
sub yuck($) {
my $errmsg = $_[0];
$errmsg =~ s/(?<=[^\n])\z/\n/;
print STDERR "$0: $errmsg";
}
process_input(\&countem);
sub countem {
my ($_, $file) = @_;
my (
@paras, @lines, @words,
$paracount, $linecount, $wordcount,
$grafcount, $charcount, $bytecount,
);
if ($charcount = length($_)) {
$wordcount = eval { @words = split m{ \p{Space}+ }x };
yuck "error splitting words: $@" if $@;
$linecount = eval { @lines = split m{ \R }x };
yuck "error splitting lines: $@" if $@;
$grafcount = 0;
$grafcount++ while /\X/g;
#$grafcount = eval { @lines = split m{ \R }x };
yuck "error splitting lines: $@" if $@;
$paracount = eval { @paras = split m{ \R{2,} }x };
yuck "error splitting paras: $@" if $@;
if ($linecount && !/\R\z/) {
yuck("missing linebreak at end of corrupted textfiile $file");
$linecount .= "*";
$paracount .= "*";
}
}
$bytecount = tell;
if (-e $file) {
$bytecount = -s $file;
if ($bytecount != -s $file) {
yuck "filesize of $file differs from bytecount\n";
$Errors++;
}
}
my $mask = "%8s " x 6 . "%s\n";
printf $mask => qw{ Paras Lines Words Graphs Chars Bytes File } unless $Headers++;
printf $mask => map( { show_undef($_) }
$paracount, $linecount,
$wordcount, $grafcount,
$charcount, $bytecount,
), $file;
}
sub show_undef {
my $value = shift;
return defined($value)
? $value
: "undef";
}
END {
close(STDOUT) || die "$0: can't close STDOUT: $!";
exit($Errors != 0);
}
sub process_input {
my $function = shift();
my $enc;
if (@ARGV == 0 && -t) {
warn "$0: reading from stdin, type ^D to end or ^C to kill.\n";
}
unshift(@ARGV, "-") if @ARGV == 0;
FILE:
for my $file (@ARGV) {
# don't let magic open make an output handle
next if -e $file && ! -f _;
my $quasi_filename = fix_extension($file);
$file = "standard input" if $file eq q(-);
$quasi_filename =~ s/^(?=\s*[>|])/< /;
no strict "refs";
my $fh = $file; # is *so* a lexical filehandle! ☺
unless (open($fh, $quasi_filename)) {
yuck("couldn't open $quasi_filename: $!");
next FILE;
}
set_encoding($fh, $file) || next FILE;
my $whole_file = eval {
use warnings "FATAL" => "all";
local $/;
scalar <$fh>;
};
if ($@) {
$@ =~ s/ at \K.*? line \d+.*/$file line $./;
yuck($@);
next FILE;
}
$function->($whole_file, $file);
unless (close $fh) {
yuck("couldn't close $quasi_filename at line $.: $!");
next FILE;
}
} # foreach file
}
sub set_encoding(*$) {
my ($handle, $path) = @_;
my $enc_name = "utf8";
if ($path && $path =~ m{ \. ([^\s.]+) \z }x) {
my $ext = $1;
die unless defined $ext;
require Encode;
if (my $enc_obj = Encode::find_encoding($ext)) {
my $name = $enc_obj->name || $ext;
$enc_name = "encoding($name)";
}
}
return 1 if eval {
use warnings FATAL => "all";
no strict "refs";
binmode($handle, ":$enc_name");
1;
};
for ($@) {
s/ at .* line \d+\.//;
s/$/ for $path/;
}
yuck("set_encoding: $@");
return undef;
}
sub fix_extension {
my $path = shift();
my %Compress = (
Z => "zcat",
z => "gzcat", # for uncompressing
gz => "gzcat",
bz => "bzcat",
bz2 => "bzcat",
bzip => "bzcat",
bzip2 => "bzcat",
lzma => "lzcat",
);
if ($path =~ m{ \. ( [^.\s] +) \z }x) {
if (my $prog = $Compress{$1}) {
return "$prog $path |";
}
}
return $path;
}
Perl Power Tools プロジェクトがあり、その目標は、主にUnixを奪われたオペレーティングシステム上のユーティリティのために、すべてのUnixbinユーティリティを再構築することです。はい、そうしました wc 。実装はやり過ぎですが、 POSIX準拠 です。
GNU準拠の true の実装を見ると、少しばかげています。
文字カウントソリューションを探しているときに、私はこれに偶然出会いました。確かに、私はPerlについてほとんど何も知らないので、これのいくつかはベースから外れているかもしれませんが、ここにnewtのソリューションの私の微調整があります。
まず、とにかく行数変数が組み込まれているので、それを使用しました。これはおそらくもう少し効率的だと思います。現状では、文字数には改行文字が含まれているため、おそらく望んでいるものではないため、$ _を使用しました。 Perlはsplit（）が行われる方法についても不平を言いました（暗黙の分割、参照： Perlが「@_への暗黙の分割の使用は非推奨です」と不平を言うのはなぜですか？ ）それで私はそれを微調整しました。私の入力ファイルはUTF-8なので、そのように開いた。これはおそらく、入力ファイルに非ASCII文字が含まれている正しい文字数を取得するのに役立ちます。
コードは次のとおりです。
open(FILE, "<:encoding(UTF-8)", "file.txt") or die "Could not open file: $!";
my ($lines, $words, $chars) = (0,0,0);
my @wordcounter;
while (<FILE>) {
chomp($_);
$chars += length($_);
@wordcounter = split(/\W+/, $_);
$words += @wordcounter;
}
$lines = $.;
close FILE;
print "\nlines=$lines, words=$words, chars=$chars\n";
固定サイズのチャンクでファイルを読み取る方が、行ごとに読み取るよりも効率的です。 wcバイナリがこれを行います。
#!/usr/bin/env Perl
use constant BLOCK_SIZE => 16384;
for my $file (@ARGV) {
open my $fh, '<', $file or do {
warn "couldn't open $file: $!\n";
continue;
};
my ($chars, $words, $lines) = (0, 0, 0);
my ($new_Word, $new_line);
while ((my $size = sysread $fh, local $_, BLOCK_SIZE) > 0) {
$chars += $size;
$words += /\s+/g;
$words-- if $new_Word && /\A\s/;
$lines += () = /\n/g;
$new_Word = /\s\Z/;
$new_line = /\n\Z/;
}
$lines-- if $new_line;
print "\t$lines\t$words\t$chars\t$file\n";
}
深刻ではない答え：
system("wc foo");
バイトではなくCHARSをカウントできるようにするには、次のことを考慮してください。
（utf8に保存されている中国語またはキリル文字とファイルで試してみてください）
use utf8;
my $file='file.txt';
my $LAYER = ':encoding(UTF-8)';
open( my $fh, '<', $file )
|| die( "$file couldn't be opened: $!" );
binmode( $fh, $LAYER );
read $fh, my $txt, -s $file;
close $fh;
print length $txt,$/;
use bytes;
print length $txt,$/;
これはPerlの初心者に役立つかもしれません。 MS Wordのカウント機能をシミュレートして、Linuxでwcを使用しても表示されない機能をもう1つ追加しました。
- 行数
- 言葉の数
- スペース付きの文字数
- スペースのない文字数（wcは出力にこれを表示しませんが、Microsoftの単語はそれを示します。）
URLは次のとおりです。 ファイル内の単語、文字、行を数える