Lossless English language text compression challenge

Question

Challenge:

Your challenge (should you choose to accept it) is to compress and decompress the 5MB "Complete Works of William Shakespeare" as found here: http://www.gutenberg.org/cache/epub/100/pg100.txt

(MD5: a810f89e9f8e213aebd06b9f8c5157d8)

Rules:

• You must take input via STDIN and output via STDOUT...
• ...and you must provide an identical decompressed result to the input.
  • (This is to say you must be able to cat inpt.txt | ./cmprss | ./dcmpress | md5 and get the same MD5 as above.)
  • (Anything via STDERR is to be discarded.)
• You must use less than 2048 characters for your total source code.
  • (This is not code-golf. You are not being scored based on length of source-code. This is was just a rule to keep things finite.)
  • (Take the concatenated length of all source code if you have split it out.)
• You must be able to (theoretically) process similar plain-text inputs too.
  • (e.g. hard coding a mechanism which is only capable of outputting the provided Shakespeare input is unacceptable.)
  • (The compressed size of other documents is irrelevant - provided the decompressed result is identical to the alternative input.)
• You may use any choice of language(s).
  • (e.g. feel free to compress using awk and decompress using java)
• You may write two separate programs or combine them with some form of "switch" as you please.
  • (There must be clear demonstrations of how to invoke both the compression and decompression modes)
• You may not use any external commands (e.g. through exec()).
  • (If you are using a shell language - sorry. You'll have to make do with built-ins. You're welcome to post an "unacceptable" answer for the sake of sharing and enjoyment - but it won't be judged!)
• You may not use any built-in or library provided functions who's stated purpose is to compress data (like gz, etc)
  • (Altering the encoding is not considered compression in this context. Some discretion may be applied here. Feel free to argue the acceptableness of your solution in the submission.)
• Please try to have fun if choose to participate!

All good competitions have an objective definition of winning; ergo:

• Provided all rules are adhered to, the smallest compressed output (in STDOUT bytes) wins.
  • (Report your output please via ./cmprss | wc -c)
• In the event of a draw (identical output sizes), the most community up-voted wins.
• In the event of a second draw (identical community up-votes), I'll pick a winner based on completely subjective examination of elegance and pure genius. ;-)

How to submit:

Please format your entry using this template:

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

<description>  (Detail is encouraged!)

    <CODE...
    ...>

<run instructions>

I would encourage readers and submitters to converse through comments - I believe there's real opportunity for people to learn and become better programmers through codegolf.stack.

Winning:

I'm away on vacation soon: I may (or may not) be monitoring submissions over the next few weeks and will draw the challenge to a close on the 19th September. I hope this offers a good opportunity for people to think and submit - and for a positive sharing of techniques and ideas.

If you've learned something new from participating (as a reader or submitter) please leave a comment of encouragement.

Answer 1

Perl 5, 3651284

Just a simple word-based dictionary scheme. Analyzes the word frequency of the corpus, and uses that to determine whether to use one or two bytes of overhead per word. Uses two special symbols for the bytes \0 and \1 since they do not appear in the corpus. There are plenty of other symbols that could be used. This was not done. Does not do any huffman encoding or any of that jazz.

Compression script 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;
    }
}

Decompression script 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;
    }
}

Run using:

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