Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Re: Re: Any news on Compress::LZW?

by rcaputo (Chaplain)
on Jun 20, 2003 at 05:48 UTC ( #267467=note: print w/ replies, xml ) Need Help??


in reply to Re: Any news on Compress::LZW?
in thread Any news on Compress::LZW?

This is that author speaking. Thanks for the e-mail! I'd be delighted if you used my code. It would be a wonderful way to commemorate the end of an error. :)

What you found on the web is probably hideously out of date, however. Here is the latest, self-testing version.

#!/usr/bin/perl -w # Pure-perl LZW implementation. The implementation is Copyright 2003 # by Rocco Caputo. Where applicable, all rights are reserved. The # author makes no claim of rights to the LZW algorithm, which is # patented by UniSys, or something. # # This implementation is being released under the same terms as Perl # itself. use warnings; use strict; my $original_char_stream = <<'EOS'; Intra-universe security is easy enough. Inter-universe security will be hard. I have half an idea for something involving audit trails that may work. It may be necessary to backtrack and validate an object recorded path before executing the object. For example, imagine USENET if each host in the Path header was asked to vouch for the object having been there. The ratio of positive answers over total hosts in the trail would determine a "percent of certainty". Combined with an average "percent of trustability" for each host, the current universe would come up with a "total trustability" percent to test against a threshhold. EOS ### Shared ########################################################### +######### my @code_stream; ### Encoding. ######################################################## +######### { my %dict; my $next_code = 256; $dict{chr $_} = $_ for 0..255; my $code = ""; my $c_index = 0; while ($c_index < length($original_char_stream)) { my $next_char = substr($original_char_stream, $c_index++, 1); my $possible_code = $code . $next_char; if (exists $dict{$possible_code}) { $code = $possible_code; } else { push @code_stream, $dict{$code}; $dict{$possible_code} = $next_code++; $code = $next_char; } } push @code_stream, $dict{$code}; } ### Decoding. ######################################################## +######### my $decoded_char_stream = ""; { my %dict; my $next_code = 256; $dict{$_} = chr($_) for 0..255; my $code_word = shift @code_stream; $decoded_char_stream .= $dict{$code_word}; while (@code_stream) { my $previous_word = $dict{$code_word}; $code_word = shift @code_stream; if (exists $dict{$code_word}) { my $decoded_word = $dict{$code_word}; $decoded_char_stream .= $decoded_word; $dict{$next_code++} = $previous_word . substr($decoded_word, 0, 1); } else { my $decoded_word = $previous_word . substr($previous_word, 0, 1) +; $decoded_char_stream .= $decoded_word; $dict{$next_code++} = $decoded_word; } } } ### Final test. ###################################################### +######### if ($original_char_stream eq $decoded_char_stream) { print "Compressed and decompressed strings match! :)\n"; } else { print "Compressed and decompressed strings don't match! :(\n"; }

-- Rocco Caputo - troc@pobox.com - poe.perl.org


Comment on Re: Re: Any news on Compress::LZW?
Download Code
Re: Re: Re: Any news on Compress::LZW?
by meredith (Friar) on Jun 20, 2003 at 12:15 UTC
    Thanks for the response! I had assumed that you were no longer listening to that email address.

    I had actually already used your code to understand the LZW method, but reworked some code from the CPAN module Compress::SelfExtracting to make the actual code. I'll be rewriting much of this code too, though, but your code was a great help at getting started. Check this thread: RFC: Compress::LZW for more info. Thanks again! I will keep this new script in my reference collection.

    mhoward - at - hattmoward.org

      Apologies for not responding sooner. I was at YAPC::NA and didn't have a laptop. Remind me never to do that again. :)

      -- Rocco Caputo - troc@pobox.com - poe.perl.org

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (13)
As of 2014-08-22 10:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (153 votes), past polls