diff options
| -rw-r--r-- | challenge-022/randy-lauen/perl6/ch-2.p6 | 87 |
1 files changed, 87 insertions, 0 deletions
diff --git a/challenge-022/randy-lauen/perl6/ch-2.p6 b/challenge-022/randy-lauen/perl6/ch-2.p6 new file mode 100644 index 0000000000..80255a29c2 --- /dev/null +++ b/challenge-022/randy-lauen/perl6/ch-2.p6 @@ -0,0 +1,87 @@ +#!/usr/bin/env perl6 + +=begin SYNOPSIS + +Task: +Write a script to implement Lempel–Ziv–Welch (LZW) compression algorithm. +The script should have method to encode/decode algorithm. + +This script is a port of my Perl5 solution, which itself was a port of LZW-B at +https://marknelson.us/posts/2011/11/08/lzw-revisited.html. + +Usage: + $ perl6 ch-2.p6 --encode file.txt > file.txt.encoded + $ perl6 ch-2.p6 --decode file.txt.encoded > file.txt.decoded + +=end SYNOPSIS + +use P5pack; + +constant $MAX-CODE = 32767; + +multi MAIN( Str $file where *.IO.r, Bool :$encode! ) { + encode( $file ); +} + +multi MAIN( Str $file where *.IO.r, Bool :$decode! ) { + decode( $file ); +} + +sub encode( Str $file ) { + my $fh = $file.IO.open( :bin ); + + my %codes = (^256).map: { .chr => $_ }; + my $next-code = 256; + my $current-buffer = Buf.new; + + while my $buf = $fh.read( 1 ) { + $current-buffer.append: $buf; + if %codes{ $current-buffer.decode('latin1') }:!exists { + if $next-code <= $MAX-CODE { + %codes{ $current-buffer.decode('latin1') } = $next-code++; + } + $current-buffer.pop(); + + my $bytes = pack( 'S', %codes{ $current-buffer.decode('latin1') } ); + $*OUT.write( $bytes ); + $current-buffer = $buf; + } + } + + if ( $current-buffer.bytes ) { + my $bytes = pack( 'S', %codes{ $current-buffer.decode('latin1') } ); + $*OUT.write( $bytes ); + } + + $fh.close; + + return; +} + + +sub decode( Str $file ) { + my $fh = $file.IO.open( :bin ); + + my %strings = (^256).map: { $_ => Buf.new( $_ ) }; + my $previous = Buf.new; + my $next-code = 256; + + while my $buf = $fh.read( 2 ) { + my $code = unpack( 'S', $buf ); + + if %strings{ $code }:!exists { + %strings{ $code } = Buf.new( $previous.list.flat, $previous[0] ); + } + $*OUT.write( %strings{ $code } ); + if ( $previous.bytes && $next-code <= $MAX-CODE ) { + %strings{ $next-code++ } = Buf.new( $previous.list.flat, %strings{ $code }[0] ); + } + $previous = Buf.new( %strings{ $code } ); + } + + $fh.close; + + return; +} + + |