Permalink
Fetching contributors…
Cannot retrieve contributors at this time
289 lines (256 sloc) 8.45 KB
use v6;
use Test;
plan 25;
{
# P11 (*) Modified run-length encoding.
#
# Modify the result of problem P10 in such a way that if an element has no
# duplicates it is simply copied into the result list. Only elements with
# duplicates are transferred as (N E) lists.
#
# Example:
# * (encode-modified '(a a a a b c c a a d e e e e))
# ((4 A) B (2 C) (2 A) D (4 E))
sub encode (*@list)returns Array {
my $count = 1;
my (@encoded, $previous, $x);
for @list {
$x = $_;
if defined $previous {
if $x eq $previous {
$count++;
next;
}
@encoded.push( 1 == $count ?? $previous !! $[$count, $previous]);
$count = 1;
}
$previous = $x;
}
@encoded.push($[$count, $x]);
return @encoded;
}
is encode(<a a a a b c c a a d e e e e>),
[ $[<4 a>], 'b', $[<2 c>], $[<2 a>], 'd', $[<4 e>] ],
'We should be able to run-length encode lists';
}
{
# P12 (**) Decode a run-length encoded list.
#
# Given a run-length code list generated as specified in problem P11.
# Construct its uncompressed version.
sub decode(*@list) returns Iterable {
gather {
for @list -> $elem {
take $elem.isa(Array) ?? ($elem[1] xx $elem[0]).Slip !! $elem;
}
}
}
is decode( $[4, "a"], "b", $[2, "c"], $[2, "a"], "d", $[4, "e"] ),
<a a a a b c c a a d e e e e>,
'We should be able to decode run-length encoded lists';
}
{
# P13 (**) Run-length encoding of a list (direct solution).
#
# Implement the so-called run-length encoding data compression method directly.
# I.e. don't explicitly create the sublists containing the duplicates, as in
# problem P09, but only count them. As in problem P11, simplify the result list
# by replacing the singleton lists (1 X) by X.
#
# Example:
# * (encode-direct '(a a a a b c c a a d e e e e))
# ((4 A) B (2 C) (2 A) D (4 E))
sub encode_direct {
my @chars = @_;
my $encoded = '';
my $prev_ch = '';
my $ch_cnt = 0;
while (my $ch = @chars.shift) {
if ($ch ~~ $prev_ch) {
$ch_cnt++;
# If it's the last char, add it.
if (@chars.elems == 0) {
if ($ch_cnt != 1) {
$encoded ~= $ch_cnt;
}
$encoded ~= $ch;
}
}
# the very first one..
elsif ($prev_ch eq '') {
$ch_cnt++;
# If it's the last char, add it.
if (@chars.elems == 0) {
if ($ch_cnt != 1) {
$encoded ~= $ch_cnt;
}
$encoded ~= $ch;
}
}
# not a match, but a new letter
else {
if ($ch_cnt != 1) {
$encoded ~= $ch_cnt;
}
$encoded ~= $prev_ch;
$ch_cnt = 1;
}
$prev_ch = $ch;
}
return $encoded;
}
# Alternative solution
sub encode_direct2(*@array is copy) returns Str {
my ($packed, $count);
while @array {
if @array > 1 && @array[0] eq @array[1] {
$count++;
}
else {
$packed ~=( $count ?? ($count+1) ~ @array[0] !! @array[0] );
$count=0;
}
@array.shift;
}
return $packed // '';
}
is encode_direct(()),'', 'We should be able to encode_direct an empty list';
is encode_direct(<a>), 'a', '.. or a one-element iist';
is encode_direct(<a a>), '2a', '.. or a n-ary list with always same element';
is encode_direct(<a a a a b c c a a d e e e e>),
'4ab2c2ad4e',
'.. or a generic list';
is encode_direct2(()),'', 'We should be able to encode_direct2 an empty list';
is encode_direct2(<a>), 'a', '.. or a one-element iist';
is encode_direct2(<a a>), '2a', '.. or a n-ary list with always same element';
is encode_direct2(<a a a a b c c a a d e e e e>),
'4ab2c2ad4e',
'.. or a generic list';
}
{
# P14 (*) Duplicate the elements of a list.
#
# Example:
# * (dupli '(a b c c d))
# (A A B B C C C C D D)
is map({ ($_ xx 2).Slip }, <a b c c d>), <a a b b c c c c d d>,
'We should be able to duplicate the elements of a list';
}
{
my @result = EVAL '<a b c c d> ==> map { ($_ xx 2).Slip }';
is @result, <a a b b c c c c d d>,
'We should be able to duplicate the elements of a list';
}
{
# P15 (**) Replicate the elements of a list a given number of times.
#
# Example:
# * (repli '(a b c) 3)
# (A A A B B B C C C)
sub repli (@list, Int $count) {
return map { ($_ xx $count).Slip }, @list;
}
is repli(<a b c>, 3), <a a a b b b c c c>,
'We should be able to replicate array elements';
}
{
# P16 (**) Drop every N'th element from a list.
#
# Example:
# * (drop '(a b c d e f g h i k) 3)
# (A B D E G H K)
sub drop(@list, Int $nth) {
return map { @list[$_] }, grep { ($_+1) % $nth }, 0 .. @list.elems - 1;
}
is drop(<a b c d e f g h i k>, 3), <a b d e g h k>,
'We should be able to drop list elements';
sub drop2(@list, Int $nth) {
return map { @list[$_] if ($_+1) % $nth }, ^@list;
}
is drop2(<a b c d e f g h i k>, 3), <a b d e g h k>,
'We should be able to drop list elements based on if returning ()';
sub drop3(@list, Int $nth) {
gather for ^@list {
take @list[$_] if ($_+1) % $nth;
}
}
is drop3(<a b c d e f g h i k>, 3), <a b d e g h k>,
'We should be able to drop list elements using gather';
sub drop4(@list, Int $nth) {
((@list[$_] if ($_+1) % $nth) for ^@list)
}
is drop4(<a b c d e f g h i k>, 3), <a b d e g h k>,
'We should be able to drop list elements using (statement if) for';
sub drop5(@list, Int $nth) {
(@list[$_] if ($_+1) % $nth for ^@list)
}
is drop5(<a b c d e f g h i k>, 3), <a b d e g h k>,
'We should be able to drop list elements using list comprehension';
}
{
# P17 (*) Split a list into two parts; the length of the first part is given.
#
# Do not use any predefined predicates.
#
# Example:
# * (split '(a b c d e f g h i k) 3)
# ( (A B C) (D E F G H I K))
sub splitter ( @array is copy, Int $length ) {
my @head = @array.splice(0, $length);
return ($@head, $@array);
}
my ( $a, $b ) = splitter(<a b c d e f g h i j k>, 3);
is $a, <a b c>,
'The first array in the split should be correct';
is $b, <d e f g h i j k>, '... as should the second';
}
{
# P18 (**) Extract a slice from a list.
#
# Given two indices, I and K, the slice is the list containing the elements
# between the I'th and K'th element of the original list
# (both limits included).
# Start counting the elements with 1.
#
# Example:
# * (slice '(a b c d e f g h i k) 3 7)
# (C D E F G)
my @array = <a b c d e f g h i j k>;
is @array[3..7], <d e f g h>, 'We should be able to slice lists';
}
{
# P19 (**) Rotate a list N places to the left.
#
# Examples:
# * (rotate '(a b c d e f g h) 3)
# (D E F G H A B C)
#
# * (rotate '(a b c d e f g h) -2)
# (G H A B C D E F)
#
# Hint: Use the predefined functions length and append, as well as the result of
# problem P17.
sub rotate (Int $times is copy, *@list is copy) returns Array {
if $times < 0 {
$times += @list.elems;
}
@list.push: @list.shift for 1 .. $times;
return @list;
}
is rotate(3, <a b c d e f g h>), <d e f g h a b c>,
'We should be able to rotate lists forwards';
is rotate(-2, <a b c d e f g h>), <g h a b c d e f>,
'... and backwards';
}
{
# P20 (*) Remove the K'th element from a list.
#
# Example:
# * (remove-at '(a b c d) 2)
# (A C D)
my @array = <a b c d>;
is @array.splice(1,1), <b>,
'We should be able to remove elements from a list';
is @array, <a c d>, '... and have the correct list as the result';
}
# vim: ft=perl6