无损英语文本压缩挑战[关闭]

挑战：

您面临的挑战（您应该选择接受它）是压缩和解压缩5MB的“ 威廉·莎士比亚全集 ”，如下所示：http : //www.gutenberg.org/cache/epub/100/pg100.txt

（MD5： a810f89e9f8e213aebd06b9f8c5157d8）

规则：

• 您必须STDIN通过STDOUT... 输入和通过... 输出
• ...并且您必须为输入提供相同的解压缩结果。
  • （也就是说，您必须能够获得cat inpt.txt | ./cmprss | ./dcmpress | md5和上面相同的 MD5。）
  • （任何via STDERR都将被丢弃。）
• 您的总源代码必须使用少于2048个字符。
  • （这是不是代码高尔夫球场。你是不是是基于源代码的长度进球了。这是只是一个让事情变得有限规则。）
  • （如果已拆分，请采用所有源代码的串联长度。）
• 您还必须能够（理论上）处理类似的纯文本输入。
  • （例如，硬编码仅能输出所提供的莎士比亚输入的机制是不可接受的。）
  • （其他文档的压缩大小无关紧要，只要解压缩的结果与替代输入相同即可。）
• 您可以使用任何一种或多种语言。
  • （例如，随时使用进行压缩awk和进行解压缩java）
• 您可以编写两个单独的程序，也可以根据需要将它们与某种形式的“开关”组合在一起。
  • （必须清楚演示如何调用压缩和解压缩模式）
• 您不得使用任何外部命令（例如，通过exec()）。
  • （如果您使用的是外壳语言，对不起。您必须使用内置的语言。欢迎您发布“不可接受的”答案，以便分享和享受，但不会被评判！ ）
• 您不得使用任何内置功能或库提供的功能，这些功能的目的是压缩数据（例如gz，等）
  • （在这种情况下，更改编码不视为压缩。在这里可以酌情采取一些措施。请在提交中随意争论您的解决方案的可接受性。）
• 如果选择参加，请尝试玩乐！

所有好的比赛都有获胜的客观定义；因此

• 如果遵守所有规则，则最小的压缩输出（以STDOUT字节为单位）将获胜。
  • （请通过报告您的输出./cmprss | wc -c）
• 在平局的情况下（相同的输出大小），大多数社区会投票赞成获胜。
• 如果第二次抽奖（社区共同投票），我将基于对主观上的优雅和天才的完全选拔，选出一名获奖者。 ;-)

提交方式：

请使用以下模板格式化您的条目：

<language>, <compressed_size>
-----------------------------

<description>  (Detail is encouraged!)

    <CODE...
    ...>

<run instructions>

我鼓励读者和提交者通过评论进行交流-我相信人们确实有机会通过codegolf.stack学习并成为更好的程序员。

获奖情况：

我即将休假：我可能会（也可能不会）在接下来的几周内监控提交的内容，并将在9月19日结束这一挑战。我希望这为人们提供了一个思考和提交的好机会-以及积极分享技术和想法。

如果您从参与者（作为读者或提交者）中学到了一些新东西，请留下鼓励的评论。

Perl 5，3651284

只是一个简单的基于单词的字典方案。分析语料库的单词频率，并使用该频率确定每个单词使用一还是两个字节的开销。对字节\ 0和\ 1使用两个特殊符号，因为它们未出现在语料库中。还有许多其他符号可以使用。尚未完成。不执行任何霍夫曼编码或任何爵士乐。

压缩脚本shakespeare.pl：

use strict;
use warnings;
use bytes;

my $text = join "", <>;
my @words = split/([^a-zA-Z0-9]+)/, $text;


my %charfreq;
for( my $i = 0; $i<length($text); ++$i ) {
    $charfreq{ substr($text, $i, 1) }++
}
for my $i ( 0..255 ) {
    my $c = chr($i);
    my $cnt = $charfreq{$c} // 0;
}



my %word_freq;
foreach my $word ( @words ) {
    $word_freq{ $word }++;
}


my $cnt = 0;
my ( @dict, %rdict );
foreach my $word ( sort { $word_freq{$b} <=> $word_freq{$a} || $b cmp $a } keys %word_freq ) {
    last if $word_freq{ $word } == 1; 


    my $repl_length = $cnt < 127 ? 2 : 3;
    if( length( $word ) > $repl_length ) {
        push @dict, $word;
        $rdict{ $word } = $cnt;
        $cnt++;
    }
}


foreach my $index ( 0..$
    print "$dict[$index]\0";
}
print "\1";


foreach my $word ( @words ) {
    my $index = $rdict{ $word };
    if ( defined $index && $index <= 127 ) {
        print "\0" . chr( $index );
    } elsif ( defined $index ) {
        my $byte1 = $index & 127;
        my $byte2 = $index >> 7;
        print "\1" . chr( $byte2 ) . chr( $byte1 );
    } else {
        print $word;
    }
}

解压缩脚本deshakespeare.pl：

use strict;
use warnings;
use bytes;

local $/;
my $compressed = <>;
my $text = $compressed;
$text =~ s/^.+?\x{1}//ms;
my $dictionary = $compressed;
$dictionary =~ s/\x{1}.*$//ms;


my $cnt = 0;
my @dict;
foreach my $word ( split "\0", $dictionary ) {

    push @dict, $word;
}


my @words = split /(\x{0}.|\x{1}..)/ms, $text;
foreach my $word ( @words ) {
    if( $word =~ /^\x{0}(.)/ms ) {
        print $dict[ ord( $1 ) ];
    } elsif( $word =~ /^\x{1}(.)(.)/ms ) {
        my $byte1 = ord( $1 );
        my $byte2 = ord( $2 );
        my $index = ( $byte1 << 7 ) + $byte2;
        print $dict[ $index ];
    } else {
        print $word;
    }
}

使用以下命令运行：

perl shakespeare.pl < pg100.txt >pg100.txt.compressed
perl deshakespeare.pl <pg100.txt.compressed >pg100.txt.restored
diff pg100.txt pg100.txt.restored