Skip to content

Commit b395cf8

Browse files
committed
I've got a match
1 parent 61305cb commit b395cf8

File tree

1 file changed

+176
-0
lines changed

1 file changed

+176
-0
lines changed
Lines changed: 176 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,176 @@
1+
---
2+
layout: post
3+
title: "Your Embrace and My Collapse: Weekly Challenge #318"
4+
author: "Dave Jacoby"
5+
date: "2025-04-24 14:28:23 -0400"
6+
categories: ""
7+
---
8+
9+
Welcome to [**_Weekly Challenge #318!_**](https://theweeklychallenge.org/blog/perl-weekly-challenge-318/) **318** is a [sphenic number](https://en.wikipedia.org/wiki/Sphenic_number) and is also [the area code for the northern part of Louisiana](https://en.wikipedia.org/wiki/Area_code_318).
10+
11+
### Task 1: Group Position
12+
13+
> Submitted by: Mohammad Sajid Anwar
14+
> You are given a string of lowercase letters.
15+
>
16+
> Write a script to find the position of all groups in the given string. Three or more consecutive letters form a group. Return "” if none found.
17+
18+
#### Let's Talk About It
19+
20+
So, if we're given `skulllike`, we're to expect `lll`. And I had a little problem with it. It's _all_ regular expressions (or at least my solution is; you might see another way, like nested for loops and `substr`) and I was having problems with the correct backreferences, so my first pass was like:
21+
22+
```perl
23+
my @chars = $example =~ m{(\w)\1{2,}}gmx;
24+
for my $c (@chars) {
25+
my $str = $example =~ m{($c{3,})}mix;
26+
push @output, $str;
27+
}
28+
```
29+
But consider this regex: `((\w)\w\w)`
30+
31+
We want to get `abc` and not just `a`. On the outside, we're looking at `$1` matching `abc` and `$2` matching the inner `a`. That's outside; inside the regex, we'd be dealing with `\1` and `\2`, and `((\w)\1)` is the outer match referencing itself.
32+
33+
So, we get to `@output = $example =~ m{((\w)\2{2,}}`.
34+
The first element is the least number of allowable matches, and after the comma would be the maximum. `'aaaaaaaaaa' =~ m{(\w{2,5})}mx` would put `aaaaa` into `$1`, not all ten `a`s.
35+
36+
But `@array = $string =~ /(match(match))/gmx` puts `$1` and `$2` into `@array`. We know we have to have a certain size, so we can just `grep` out any shorter string, and we have basically a one-line answer.
37+
38+
Which, of course, I added 15 lines of comments to.
39+
40+
#### Show Me The Code!
41+
42+
```perl
43+
#!/usr/bin/env perl
44+
45+
use strict;
46+
use warnings;
47+
use experimental qw{ say state postderef signatures };
48+
49+
my @examples = (qw{ abccccd aaabcddddeefff abcdd });
50+
51+
for my $example (@examples) {
52+
my @output = group_position($example);
53+
my $output = join ', ', map { qq{"$_"} } @output;
54+
say <<"END";
55+
Input: \$str = "$example"
56+
Output: $output
57+
END
58+
}
59+
60+
sub group_position ($example) {
61+
return grep { length $_ > 2 } $example =~ m{
62+
# (\w) matches any word character
63+
# (\w)\1{2,} matches when there's one characters
64+
# that is followed by two or more identical
65+
# characters. The form is { at least, no more than}
66+
# ((\w)\1) would give problems because it's trying to
67+
# use the outer match
68+
# ((\w)\2) would return first the repeated characters
69+
# (like "aa") and then the first match itself ("a")
70+
# ((\w)\2{2,}) returns the "aaaaa" and then the "a"
71+
#
72+
# there is perhaps magic that allows (\w) to be used
73+
# within the regex but pass out, but I don't know it.
74+
# Therefore the grep.
75+
#
76+
# also //x allows you to comment your complex regular
77+
# expressions.
78+
79+
( (\w)\2{2,} )
80+
}gmx;
81+
}
82+
```
83+
84+
```text
85+
$ ./ch-1.pl
86+
Input: $str = "abccccd"
87+
Output: "cccc"
88+
89+
Input: $str = "aaabcddddeefff"
90+
Output: "aaa", "dddd", "fff"
91+
92+
Input: $str = "abcdd"
93+
Output:
94+
```
95+
96+
### Task 2: Reverse Equals
97+
98+
> Submitted by: Roger Bell_West
99+
> You are given two arrays of integers, each containing the same elements as the other.
100+
>
101+
> Write a script to return true if one array can be made to equal the other by reversing exactly one contiguous subarray.
102+
103+
#### Let's Talk About It
104+
105+
This is similar to [last week's](https://jacoby-lpwk.onrender.com/2025/04/17/we-all-live-in-a-yellow-substring-weekly-challenge-317.html) second task, except instead of strings, we're dealing with (and copying) arrays. Looping through indexes and stringifying the arrays for comparison.
106+
107+
I suppose going through element by element is the better way to compare arrays, but if you can stringify them, it works fine.
108+
109+
#### Show Me The Code!
110+
111+
```perl
112+
#!/usr/bin/env perl
113+
114+
use strict;
115+
use warnings;
116+
use experimental qw{ say state postderef signatures };
117+
118+
my @examples = (
119+
120+
[ [ 3, 2, 1, 4 ], [ 1, 2, 3, 4 ], ],
121+
[
122+
[ 1, 3, 4 ],
123+
[ 4, 1, 3 ],
124+
],
125+
[
126+
[2],
127+
[2],
128+
],
129+
130+
);
131+
132+
for my $example (@examples) {
133+
my $source = join ', ', $example->[0]->@*;
134+
my $target = join ', ', $example->[1]->@*;
135+
my $output = reverse_equals($example);
136+
say <<"END";
137+
Input: \@source = ($source)
138+
\@target = ($target)
139+
Output: $output
140+
END
141+
}
142+
143+
sub reverse_equals ($obj) {
144+
my @source = $obj->[0]->@*;
145+
my @target = $obj->[1]->@*;
146+
for my $i ( 0 .. $#source ) {
147+
for my $j ( $i + 1 .. $#source ) {
148+
my @copy = map { $_ } @source;
149+
$copy[$i] = $source[$j];
150+
$copy[$j] = $source[$i];
151+
my $t = join ' ', @target;
152+
my $c = join ' ', @copy;
153+
return 'true' if $c eq $t;
154+
}
155+
}
156+
157+
return 'false';
158+
}
159+
```
160+
161+
```text
162+
$ ./ch-2.pl
163+
Input: @source = (3, 2, 1, 4)
164+
@target = (1, 2, 3, 4)
165+
Output: true
166+
167+
Input: @source = (1, 3, 4)
168+
@target = (4, 1, 3)
169+
Output: false
170+
171+
Input: @source = (2)
172+
@target = (2)
173+
Output: false
174+
```
175+
176+
#### If you have any questions or comments, I would be glad to hear it. Ask me on [Mastodon](https://mastodon.xyz/@jacobydave) or [make an issue on my blog repo.](https://github.com/jacoby/jacoby.github.io)

0 commit comments

Comments
 (0)