From 6e732b22091c8f4e029af1ada0290808e164036f Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Sun, 18 Aug 2019 23:07:54 -0500 Subject: perl6 solution for task 1 --- challenge-022/randy-lauen/perl6/ch-1.p6 | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 challenge-022/randy-lauen/perl6/ch-1.p6 diff --git a/challenge-022/randy-lauen/perl6/ch-1.p6 b/challenge-022/randy-lauen/perl6/ch-1.p6 new file mode 100644 index 0000000000..a16df8844c --- /dev/null +++ b/challenge-022/randy-lauen/perl6/ch-1.p6 @@ -0,0 +1,5 @@ +#!/usr/bin/env perl6 + +# Task: Write a script to print first 10 Sexy Prime Pairs. Sexy primes are prime numbers that differ from each other by 6. + +say (1 .. Inf).map( { $_, $_+6 } ).flat.grep( { $^a.is-prime && $^b.is-prime } ).head(10).join("\n"); -- cgit From 6d6e3664d0a2d3d3f382ace5bb94a16ac4276c89 Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Mon, 19 Aug 2019 11:49:07 -0500 Subject: perl5 solution for task 1 --- challenge-022/randy-lauen/perl5/ch-1.pl | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 challenge-022/randy-lauen/perl5/ch-1.pl diff --git a/challenge-022/randy-lauen/perl5/ch-1.pl b/challenge-022/randy-lauen/perl5/ch-1.pl new file mode 100644 index 0000000000..9bfc8234a6 --- /dev/null +++ b/challenge-022/randy-lauen/perl5/ch-1.pl @@ -0,0 +1,18 @@ +#!/usr/bin/env perl + +use v5.26; +use strict; +use warnings; + +use Math::Prime::Util qw( prime_iterator is_prime ); + +my @matches; +my $it = prime_iterator(); + +while ( @matches < 10 ) { + my $prime = $it->(); + my $plus_six = $prime + 6; + push @matches, "$prime, $plus_six" if is_prime( $plus_six ); +} + +say join( "\n", @matches ); -- cgit From 7aa9479fd3773951c93c70004d7e8336402954a6 Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Wed, 21 Aug 2019 17:11:19 -0500 Subject: encode function --- challenge-022/randy-lauen/perl5/ch-2.pl | 46 +++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 challenge-022/randy-lauen/perl5/ch-2.pl diff --git a/challenge-022/randy-lauen/perl5/ch-2.pl b/challenge-022/randy-lauen/perl5/ch-2.pl new file mode 100644 index 0000000000..0fa86bbd95 --- /dev/null +++ b/challenge-022/randy-lauen/perl5/ch-2.pl @@ -0,0 +1,46 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use feature 'say'; + +# Task: +# Write a script to implement Lempel–Ziv–Welch (LZW) compression algorithm. +# The script should have method to encode/decode algorithm. + +# This is a port of LZW-B found at https://marknelson.us/posts/2011/11/08/lzw-revisited.html + +encode( $ARGV[0] ); + +sub encode { + my $file = shift; + + open my $in, '<', $file or die $!; + open my $out, '>', "$file.lzw" or die $!; + + my %codes = map { chr($_) => $_ } 0 .. 255; + my $next_code = 256; + my $current_string = ''; + + while ( my $line = <$in> ) { + foreach my $char ( split //, $line ) { + $current_string .= $char; + if ( !exists $codes{ $current_string } ) { + $codes{ $current_string } = $next_code++; + $current_string = substr( $current_string, 0, -1 ); + print $out pack( 'S', $codes{ $current_string} ); + $current_string = $char; + } + } + + if ( length $current_string ) { + print $out pack( 'S', $codes{ $current_string} ); + } + } + + close $in; + close $out; + + return; +} + -- cgit From 14f3ef7240468c62a55f7a1e6b7a11b506cab369 Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Wed, 21 Aug 2019 17:17:01 -0500 Subject: bug fix --- challenge-022/randy-lauen/perl5/ch-2.pl | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/challenge-022/randy-lauen/perl5/ch-2.pl b/challenge-022/randy-lauen/perl5/ch-2.pl index 0fa86bbd95..468680a919 100644 --- a/challenge-022/randy-lauen/perl5/ch-2.pl +++ b/challenge-022/randy-lauen/perl5/ch-2.pl @@ -1,15 +1,15 @@ #!/usr/bin/env perl -use strict; -use warnings; -use feature 'say'; - # Task: # Write a script to implement Lempel–Ziv–Welch (LZW) compression algorithm. # The script should have method to encode/decode algorithm. # This is a port of LZW-B found at https://marknelson.us/posts/2011/11/08/lzw-revisited.html +use strict; +use warnings; +use feature 'say'; + encode( $ARGV[0] ); sub encode { @@ -32,10 +32,10 @@ sub encode { $current_string = $char; } } + } - if ( length $current_string ) { - print $out pack( 'S', $codes{ $current_string} ); - } + if ( length $current_string ) { + print $out pack( 'S', $codes{ $current_string} ); } close $in; -- cgit From e53696169ae773df677c2a170bb217c0793aa02c Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Wed, 21 Aug 2019 22:50:44 -0500 Subject: read in one byte at a time --- challenge-022/randy-lauen/perl5/ch-2.pl | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/challenge-022/randy-lauen/perl5/ch-2.pl b/challenge-022/randy-lauen/perl5/ch-2.pl index 468680a919..6a21c43c19 100644 --- a/challenge-022/randy-lauen/perl5/ch-2.pl +++ b/challenge-022/randy-lauen/perl5/ch-2.pl @@ -15,22 +15,21 @@ encode( $ARGV[0] ); sub encode { my $file = shift; - open my $in, '<', $file or die $!; + open my $in, '<:raw', $file or die $!; open my $out, '>', "$file.lzw" or die $!; my %codes = map { chr($_) => $_ } 0 .. 255; my $next_code = 256; my $current_string = ''; - while ( my $line = <$in> ) { - foreach my $char ( split //, $line ) { - $current_string .= $char; - if ( !exists $codes{ $current_string } ) { - $codes{ $current_string } = $next_code++; - $current_string = substr( $current_string, 0, -1 ); - print $out pack( 'S', $codes{ $current_string} ); - $current_string = $char; - } + my $char; + while ( read($in, $char, 1) ) { + $current_string .= $char; + if ( !exists $codes{ $current_string } ) { + $codes{ $current_string } = $next_code++; + $current_string = substr( $current_string, 0, -1 ); + print $out pack( 'S', $codes{ $current_string} ); + $current_string = $char; } } -- cgit From abbcff1705ff61ad99c2d08a0bff8fa3055a6c02 Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Sat, 24 Aug 2019 11:22:34 -0500 Subject: perl5 solution for task2 --- challenge-022/randy-lauen/perl5/ch-2.pl | 79 ++++++++++++++++++++++++----- challenge-022/randy-lauen/perl5/test-lzw.pl | 73 ++++++++++++++++++++++++++ 2 files changed, 139 insertions(+), 13 deletions(-) create mode 100644 challenge-022/randy-lauen/perl5/test-lzw.pl diff --git a/challenge-022/randy-lauen/perl5/ch-2.pl b/challenge-022/randy-lauen/perl5/ch-2.pl index 6a21c43c19..562681e704 100644 --- a/challenge-022/randy-lauen/perl5/ch-2.pl +++ b/challenge-022/randy-lauen/perl5/ch-2.pl @@ -1,45 +1,98 @@ #!/usr/bin/env perl -# Task: -# Write a script to implement Lempel–Ziv–Welch (LZW) compression algorithm. -# The script should have method to encode/decode algorithm. +=head1 SYNOPSIS -# This is a port of LZW-B found at https://marknelson.us/posts/2011/11/08/lzw-revisited.html +Task: +Write a script to implement Lempel–Ziv–Welch (LZW) compression algorithm. +The script should have method to encode/decode algorithm. + +This is a port of LZW-B found at https://marknelson.us/posts/2011/11/08/lzw-revisited.html. +See C for how to test this program. + +=cut use strict; use warnings; use feature 'say'; -encode( $ARGV[0] ); +use Getopt::Long; + +use constant MAX_CODE => 32767; + +my $encode; +my $decode; + +GetOptions( + 'encode' => \$encode, + 'decode' => \$decode, +) or die "GetOptions failed"; + +die "Must specify either --encode or --decode" unless $encode xor $decode; + +encode( $ARGV[0] ) if $encode; +decode( $ARGV[0] ) if $decode; + +exit 0; + sub encode { my $file = shift; - open my $in, '<:raw', $file or die $!; - open my $out, '>', "$file.lzw" or die $!; + open my $fh, '<:raw', $file or die $!; my %codes = map { chr($_) => $_ } 0 .. 255; my $next_code = 256; my $current_string = ''; my $char; - while ( read($in, $char, 1) ) { + while ( read($fh, $char, 1) ) { $current_string .= $char; if ( !exists $codes{ $current_string } ) { - $codes{ $current_string } = $next_code++; + if ( $next_code <= MAX_CODE ) { + $codes{ $current_string } = $next_code++; + } $current_string = substr( $current_string, 0, -1 ); - print $out pack( 'S', $codes{ $current_string} ); + print pack( 'S<', $codes{ $current_string } ); $current_string = $char; } } if ( length $current_string ) { - print $out pack( 'S', $codes{ $current_string} ); + print pack( 'S<', $codes{ $current_string} ); } - close $in; - close $out; + close $fh; return; } + +sub decode { + my $file = shift; + + open my $fh, '<:raw', $file or die $!; + + my %strings = map { $_ => chr($_) } 0 .. 255; + my $previous_string = ''; + my $next_code = 256; + + my $code; + while ( read($fh, $code, 2) ) { + $code = unpack( 'S<', $code ); + if ( !exists $strings{ $code } ) { + $strings{ $code } = $previous_string . substr($previous_string, 0, 1); + } + print $strings{ $code }; + if ( length $previous_string && $next_code <= MAX_CODE ) { + $strings{ $next_code++ } = $previous_string . substr( $strings{ $code }, 0, 1 ); + } + $previous_string = $strings{ $code }; + } + + close $fh; + + return; +} + + + diff --git a/challenge-022/randy-lauen/perl5/test-lzw.pl b/challenge-022/randy-lauen/perl5/test-lzw.pl new file mode 100644 index 0000000000..bbfa398ffe --- /dev/null +++ b/challenge-022/randy-lauen/perl5/test-lzw.pl @@ -0,0 +1,73 @@ +#!/usr/bin/env perl + +=head1 SYNOPSIS + +To test C, do the following: +* Download the Canterbury corpus at http://www.corpus.canterbury.ac.nz/descriptions/. +* Extract it to a directory. +* Run this script with that directory as an argument. + +Example output: + + $ perl test-lzw.pl cantrbry/ + +--------------+---------+------------+-------+ + | File | Size | Compressed | Ratio | + +--------------+---------+------------+-------+ + | alice29.txt | 152089 | 70226 | 46.2% | + | asyoulik.txt | 125179 | 62748 | 50.1% | + | cp.html | 24603 | 14948 | 60.8% | + | fields.c | 11150 | 7084 | 63.5% | + | grammar.lsp | 3721 | 2818 | 75.7% | + | kennedy.xls | 1029744 | 365572 | 35.5% | + | lcet10.txt | 426754 | 184752 | 43.3% | + | plrabn12.txt | 481861 | 218914 | 45.4% | + | ptt5 | 513216 | 70242 | 13.7% | + | sum | 38240 | 25054 | 65.5% | + | xargs.1 | 4227 | 3584 | 84.8% | + +--------------+---------+------------+-------+ + +=cut + +use strict; +use warnings; +use feature 'say'; + +use Carp::Assert; +use Path::Tiny; +use File::Compare (); +use Text::Table::Tiny (); + +my $dir = $ARGV[0] // ''; +die "'$dir' must be readable directory\n" unless -r -d $dir; + +my @rows = ( [ 'File', 'Size', 'Compressed', 'Ratio' ] ); + +for my $file ( sort( path($dir)->children() ) ) { + my $basename = $file->basename; + my $encoded_file = "/tmp/$basename.encoded"; + my $decoded_file = "/tmp/$basename.decoded"; + + system("perl ./ch-2.pl --encode $file > $encoded_file") == 0 + or die "encoding failed: $?"; + + system("perl ./ch-2.pl --decode $encoded_file > $decoded_file") == 0 + or die "decoding failed: $?"; + + if ( File::Compare::compare( $file, $decoded_file ) == 0 ) { + push @rows, [ + $basename, + -s $file, + -s $encoded_file, + sprintf( "%.1f%%", 100 * ( (-s $encoded_file) / (-s $file) ) ) + ], + } + else { + die "Files differ: $file, $decoded_file"; + } +} + +say Text::Table::Tiny::generate_table( rows => \@rows, header_row => 1 ); + +exit 0; + + -- cgit From 7c3e49a88aebd13a189424cee19a83153c5ba54a Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Sun, 25 Aug 2019 14:31:21 -0500 Subject: simplify logic --- challenge-022/randy-lauen/perl5/ch-2.pl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/challenge-022/randy-lauen/perl5/ch-2.pl b/challenge-022/randy-lauen/perl5/ch-2.pl index 562681e704..1ec6533f48 100644 --- a/challenge-022/randy-lauen/perl5/ch-2.pl +++ b/challenge-022/randy-lauen/perl5/ch-2.pl @@ -52,13 +52,13 @@ sub encode { $codes{ $current_string } = $next_code++; } $current_string = substr( $current_string, 0, -1 ); - print pack( 'S<', $codes{ $current_string } ); + print pack( 'S', $codes{ $current_string } ); $current_string = $char; } } if ( length $current_string ) { - print pack( 'S<', $codes{ $current_string} ); + print pack( 'S', $codes{ $current_string} ); } close $fh; @@ -78,7 +78,7 @@ sub decode { my $code; while ( read($fh, $code, 2) ) { - $code = unpack( 'S<', $code ); + $code = unpack( 'S', $code ); if ( !exists $strings{ $code } ) { $strings{ $code } = $previous_string . substr($previous_string, 0, 1); } -- cgit From 970809cab745325b6d52532e62c39dcbb6d7ab92 Mon Sep 17 00:00:00 2001 From: Randy Lauen Date: Sun, 25 Aug 2019 17:39:03 -0500 Subject: perl6 solution for task2 --- challenge-022/randy-lauen/perl6/ch-2.p6 | 87 +++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 challenge-022/randy-lauen/perl6/ch-2.p6 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; +} + + -- cgit