initial commit of Perl solutions

3 files changed, 75 insertions, 0 deletions

diff --git a/challenge-318/adam-russell/blog.txt b/challenge-318/adam-russell/blog.txt
new file mode 100644
index 0000000000..8e1ffa1873
--- /dev/null
+++ b/challenge-318/adam-russell/blog.txt
@@ -0,0 +1 @@
+http://rabbitfarm.com/cgi-bin/blosxom/perl/2025/04/27
diff --git a/challenge-318/adam-russell/perl/ch-1.pl b/challenge-318/adam-russell/perl/ch-1.pl
new file mode 100644
index 0000000000..356122a1b0
--- /dev/null
+++ b/challenge-318/adam-russell/perl/ch-1.pl
@@ -0,0 +1,40 @@
+
+  
+use v5.40; 
+
+  
+  sub groupings{
+      my($s) = @_;
+      my @groups;
+      my @group;
+      my($current, $previous);
+      my @letters = split //, $s;
+      $previous = shift @letters;
+      @group = ($previous);
+      do {
+          $current = $_;
+          if($previous eq $current){
+              push @group, $current;
+          }
+          if($previous ne $current){
+              if(@group >= 3){
+                  push @groups, [@group];
+              }
+              @group = ($current);
+          }
+          $previous = $current;
+      } for @letters;
+      if(@group >= 3){
+          push @groups, [@group];
+      }
+      my @r = map {q/"/ . join(q//, @{$_}) . q/"/ } @groups;
+      return join(q/, /, @r) || q/""/;
+  }
+
+  
+MAIN:{
+  say groupings q/abccccd/;
+  say groupings q/aaabcddddeefff/;
+  say groupings q/abcdd/;
+}
+
diff --git a/challenge-318/adam-russell/perl/ch-2.pl b/challenge-318/adam-russell/perl/ch-2.pl
new file mode 100644
index 0000000000..b03f6584cb
--- /dev/null
+++ b/challenge-318/adam-russell/perl/ch-2.pl
@@ -0,0 +1,34 @@
+
+  
+use v5.40; 
+
+  sub reverse_equals{
+      my($u, $v) = @_;
+      my($s, $t) = ([@{$u}], [@{$v}]);
+      
+  my $indices_different = [];
+  for my $i (0 .. @{$u} - 1){
+      push @{$indices_different}, $i unless $u->[$i] eq $v->[$i];
+  }
+
+      
+  return 1 if @{$indices_different} == 0;   
+  $indices_different = [sort {$a <=> $b} @{$indices_different}];
+  my $last_i = $indices_different->[@{$indices_different} - 1];
+  my $length = 1 + $last_i - $indices_different->[0];
+  my @u_ = reverse @{$u}[$indices_different->[0] .. $last_i];
+  my @v_ = reverse @{$v}[$indices_different->[0] .. $last_i];
+  splice @{$u}, $indices_different->[0], $length, @u_;
+  splice @{$v}, $indices_different->[0], $length, @v_;
+  return 1 if join(q/,/, @{$u}) eq  join(q/,/, @{$t});
+  return 1 if join(q/,/, @{$v}) eq  join(q/,/, @{$s});
+  return 0;
+
+  }
+  
+MAIN:{
+  say reverse_equals [3, 2, 1, 4], [1, 2, 3, 4];
+  say reverse_equals [1, 3, 4], [4, 1, 3];
+  say reverse_equals [2], [2];
+}
+