Perl regular expression to split string by word - regex

I have a string which consists of several words (separated by Capital letter).
For example:
$string1="TestWater"; # to be splited in an array #string1=("Test","Water")
$string2="TodayIsNiceDay"; # as #string2=("Today","Is","Nice","Day")
$string3="EODIsAlwaysGood"; # as #string3=("EOD","Is","Always","Good")
I know that Perl easily split uses the split function for fixed character, or the match regex can separate $1, $2 with fixed amount of variable. But how can this be done dynamically? Thanks in advance!
That post Spliting CamelCase doesn't answer my question, my question is more related to regex in Perl, that one was in Java (differences apply here).

Use split to split a string on a regex. What you want is an upper case character not followed by an upper case character as the boundary, which can be expressed by two look-ahead assertions (perlre for details):
#!/usr/bin/perl
use warnings;
use strict;
use Test::More;
sub split_on_capital {
my ($string) = #_;
return [ split /(?=[[:upper:]](?![[:upper:]]))/, $string ]
}
is_deeply split_on_capital('TestWater'), [ 'Test', 'Water' ];
is_deeply split_on_capital('TodayIsNiceDay'), [ 'Today', 'Is', 'Nice', 'Day' ];
is_deeply split_on_capital('EODIsAlwaysGood'), [ 'EOD', 'Is', 'Always', 'Good' ];
done_testing();

You can do this by using m//g in list context, which returns a list of all matches found. (Rule of thumb: Use m//g if you know what you want to extract; use split if you know what you want to throw away.)
Your case is a bit more complicated because you want to split "EODIs" into ("EOD", "Is").
The following code handles this case:
my #words = $string =~ /\p{Lu}(?:\p{Lu}+(?!\p{Ll})|\p{Ll}*)/g;
I.e. every word starts with an uppercase letter (\p{Lu}) and is followed by either
1 or more uppercase letters (but the last one is not followed by a lowercase letter), or
0 or more lowercase letters (\p{Ll})

Related

Regular expression puzzler

I have been doing regular expression for 25+ years but I don't understand why this regex is not a match (using Perl syntax):
"unify" =~ /[iny]{3}/
# as in
perl -e 'print "Match\n" if "unify" =~ /[iny]{3}/'
Can someone help solve that riddle?
The quantifier {3} in the pattern [iny]{3} means to match a character with that pattern (either i or n or y), and then another character with the same pattern, and then another. Three -- one after another. So your string unify doesn't have that, but can muster two at most, ni.
That's been explained in other answers already. What I'd like to add is an answer to a clarification in comments: how to check for these characters appearing 3 times in the string, scattered around at will. Apart from matching that whole substring, as shown already, we can use a lookahead:
(?=[iny].*[iny].*[iny])
This does not "consume" any characters but rather "looks" ahead for the pattern, not advancing the engine from its current position. As such it can be very useful as a subpattern, in combination with other patterns in a larger regex.
A Perl example, to copy-paste on the command line:
perl -wE'say "Match" if "unify" =~ /(?=[iny].*[iny].*[iny])/'
The drawback to this, as well as to consuming the whole such substring, is the literal spelling out of all three subpatterns; what when the number need be decided dynamically? Or when it's twelve? The pattern can be built at runtime of course. In Perl, one way
my $pattern = '(?=' . join('.*', ('[iny]')x3) . ')';
and then use that in the regex.
 
For the sake of performance, for long strings and many repetitions, make that .* non-greedy
(?=[iny].*?[iny].*?[iny])
(when forming the pattern dynamically join with .*?)
A simple benchmark for illustration (in Perl)
use warnings;
use strict;
use feature 'say';
use Getopt::Long;
use List::Util qw(shuffle);
use Benchmark qw( cmpthese );
# For how many seconds to run each option (-r N, default 3),
# how many times to repeat for the test string (-n N, default 2)
my ($runfor, $n) = (3, 2);
GetOptions('r=i' => \$runfor, 'n=i' => \$n);
my $str = 'aa'
. join('', map { (shuffle 'b'..'t')x$n, 'a' } 1..$n)
. 'a'x($n+1)
. 'zzz';
my $pat_greedy = '(?=' . join('.*', ('a')x$n) . ')';
my $pat_non_greedy = '(?=' . join('.*?', ('a')x$n) . ')';
#my $pat_greedy = join('.*', ('a')x$n); # test straight match,
#my $pat_non_greedy = join('.*?', ('a')x$n); # not lookahead
sub match_repeated {
my ($s, $pla) = #_;
return ( $s =~ /$pla(.*z)/ ) ? "match" : "no match";
}
cmpthese(-$runfor, {
greedy => sub { match_repeated($str, $pat_greedy) },
non_greedy => sub { match_repeated($str, $pat_non_greedy) },
});
(Shuffling of that string is probably unneeded but I feared optimizations intruding.)
When a string is made with the factor of 20 (program.pl -n 20) the output is
Rate greedy non_greedy
greedy 56.3/s -- -100%
non_greedy 90169/s 159926% --
So ... some 1600 times better non-greedy. That test string is 7646 characters long and the pattern to match has 20 subpatterns (a) with .* between them (in greedy case); so there's a lot going on there. With default 2, so for a short string and a simpler pattern, the difference is 10%.
Btw, to test for straight-up matches (not using lookahead) just move those comment signs around the pattern variables, and it's nearly twice as bad:
Rate greedy non_greedy
greedy 56.5/s -- -100%
non_greedy 171949/s 304117% --
The letters n, i, and y aren't all adjacent. There's an f in between them.
/[iny]{3}/ matches any string that contains a substring of three letters taken from the set {i, n, y}. The letters can be in any order; they can even be repeated.
Choosing three characters three times, with replacement, means there are 33 = 27 matching substrings:
iii, iin, iiy, ini, inn, iny, iyi, iyn, iyy
nii, nin, niy, nni, nnn, nny, nyi, nyn, nyy
yii, yin, yiy, yni, ynn, yny, yyi, yyn, yyy
To match non-adjacent letters you can use one of these:
[iny].*[iny].*[iny]
[iny](.*[iny]){2}
([iny].*){3}
(The last option will work fine on its own since your search is unanchored, but might not be suitable as part of a larger regex. The final .* could match more than you intend.)
That pattern looks for three consecutive occurrences of the letters i, n, or y. You do not have three consecutive occurrences.
Perhaps you meant to use [inf] or [ify]?
Looks like you are looking for 3 consecutive letters, so yours should not match
[iny]{3} //no match
[unf]{3} //no match
[nif]{3} //matches nif
[nify]{3} //matches nif
[ify]{3} //matches ify
[uni]{3} //matches uni
Hope that helps somewhat :)
The {3} atom means "exactly three consecutive matches of the preceding element." While all of the letters in your character class are present in the string, they are not consecutive as they are separated by other characters in your string.
It isn't the order of items in the character class that's at issue. It's the fact that you can't match any combination of the three letters in your character class where exactly three of them are directly adjacent to one another in your example string.

Perl regex exclude optional word from match

I have a strings and need to extract only icnnumbers/numbers from them.
icnnumber:9876AB54321_IN
number:987654321FR
icnnumber:987654321YQ
I need to extract below data from above example.
9876AB54321
987654321FR
987654321YQ
Here is my regex, but its working for first line of data.
(icnnumber|number):(\w+)(?:_IN)
How can I have expression which would match for three set of data.
Given your strings to extract are only upper case and numeric, why use \w when that also matches _?
How about just matching:
#!/usr/bin/env perl
use strict;
use warnings;
while (<DATA>) {
m/number:([A-Z0-9]+)/;
print "$1\n";
}
__DATA__
icnnumber:9876AB54321_IN
number:987654321FR
icnnumber:987654321YQ
Another alternative to get only the values as a match using \K to reset the match buffer
\b(?:icn)?number:\K[^\W_]+
Regex demo | Perl demo
For example
my $str = 'icnnumber:9876AB54321_IN
number:987654321FR
icnnumber:987654321YQ';
while($str =~ /\b(?:icn)?number:\K[^\W_]+/g ) {
print $& . "\n";
}
Output
9876AB54321
987654321FR
987654321YQ
You may replace \w (that matches letters, digits and underscores) with [^\W_] that is almost the same, but does not match underscores:
(icnnumber|number):([^\W_]+)
See the regex demo.
If you want to make sure icnnumber and number are matched as whole words, you may add a word boundary at the start:
\b(icnnumber|number):([^\W_]+)
^^
You may even refactor the pattern a bit in order not to repeat number using an optional non-capturing group, see below:
\b((?:icn)?number):([^\W_]+)
^^^^^^^^
Pattern details
\b - a word boundary (immediately to the right, there must be start of string or a char other than letter, digit or _)
((?:icn)?number) - Group 1: an optional sequence of icn substring and then number substring
: - a : char
([^\W_]+) - Group 2: one or more letters or digits.
Just another suggestion maybe, but if your strings are always valid, you may consider just to split on a character class and pull the second index from the resulting array:
my $string= "number:987654321FR";
my #part = (split /[:_]/, $string)[1];
print #part
Or for the whole array of strings:
#Array = ("icnnumber:9876AB54321_IN", "number:987654321FR", "icnnumber:987654321YQ");
foreach (#Array)
{
my $el = (split /[:_]/, $_)[1];
print "$el\n"
}
Results in:
9876AB54321
987654321FR
987654321YQ
Regular expression can have 'icn' as an option and part of the interest is 11 characters after :.
my $re = qr/(icn)?number:(.{11})/;
Test code snippet
use strict;
use warnings;
use feature 'say';
my $re = qr/(icn)?number:(.{11})/;
while(<DATA>) {
say $2 if /$re/;
}
__DATA__
icnnumber:9876AB54321_IN
number:987654321FR
icnnumber:987654321YQ
Output
9876AB54321
987654321FR
987654321YQ
Already you got best and better answers here anyway I trying to solve your question right now.
Get the whole string,
my $str = do { local $/; <DATA> }; #print $str;
You can check the first grouping method upto _ or \b from the below line,
#arrs = ($str=~m/number\:((?:(?!\_).)*)(?:\b|\_)/ig);
(or)
You can check the non-words \W and _ for the first grouping here, and pushing the matches in the array
#arrs = ($str=~m/number\:([^\W\_]+)(?:\_|\b)/ig);
print the output
print join "\n", #arrs;
__DATA__
icnnumber:9876AB54321_IN
number:987654321FR
icnnumber:987654321YQ

Generic Regular expression in Perl for the following text

I need to match the following text with a regular expression in Perl.
PS3XAY3N5SZ4K-XX_5C9F-S801-F04BN01K-00000-00
The expression that I have written is:
(\w+)\-(\w+)\-(\w+)\-(\w+)\-(\w+)\-(\w+)
But I want something more generic. By generic what I mean is I want to have any number of hyphens (-) in it.
Maybe there is something like if - then in regex, i.e. if some character is present then look for some other thing. Can anyone please help me out?
More about my problem:
AB-ab
abc-mno-xyz
lmi-jlk-mno-xyz
......... and so on...!
I wish to match all patterns.. to be more precise my string(feel free to use \w Since I can have uppercase , lowercase , numeric and '_'underscore here.) can be considered as a set of any number of alphanumeric substrings with hyphen('-') as a delimiter
You are looking for a regex with quatifiers (see perldoc perlre - Section Quantifiers).
You have several possibilities:
/\w+(?:-\w+)+)/ will match any two groups of \w characters if linked by a hyphen (-). For example, AB-CD will match. Pay attention that with \w you are matching upper and lower case letters, so you will also match a word like pre-owned as key.
/\w+(?:-\w+){5})/ will match keys with exactly 6 groups. It's equivalent to the one you have
/\w+(?:-\w+){5,})/ will match keys with 6 groups or more.
If there are more than one key in the document, you can do an implicit loop in the regex with the /g option.
#!/usr/bin/env perl
use strict;
use warnings;
use feature qw{say};
use Data::Dumper;
my $text = "some text here PS3XAY3N5SZ4K-XX_5C9F-S801-F04BN01K-00000-00 some text there";
my #matches = $text =~ /\w+(?:-\w+)+)/g;
print Dumper(\#matches);
Result:
$VAR1 = [
'PS3XAY3N5SZ4K-XX_5C9F-S801-F04BN01K-00000-00'
];
How about using split:
my $str = 'PS3XAY3N5SZ4K-XX_5C9F-S801-F04BN01K-00000-00';
my #elem = split(/-/, $str);
Edit according to comments:
#!/usr/bin/perl
use Data::Dumper;
use Modern::Perl;
my $str = 'Text before PS3XAY3N5SZ4K-XX_5C9F-S801-F04BN01K-00000-00 text after';
my ($str2) = $str =~ /(\w+(?:-\w+)+)/;
my #elem = split(/-/, $str2);
say Dumper\#elem;
Output:
$VAR1 = [
'PS3XAY3N5SZ4K',
'XX_5C9F',
'S801',
'F04BN01K',
'00000',
'00'
];

Perl - Regex to extract only the comma-separated strings

I have a question I am hoping someone could help with...
I have a variable that contains the content from a webpage (scraped using WWW::Mechanize).
The variable contains data such as these:
$var = "ewrfs sdfdsf cat_dog,horse,rabbit,chicken-pig"
$var = "fdsf iiukui aawwe dffg elephant,MOUSE_RAT,spider,lion-tiger hdsfds jdlkf sdf"
$var = "dsadp poids pewqwe ANTELOPE-GIRAFFE,frOG,fish,crab,kangaROO-KOALA sdfdsf hkew"
The only bits I am interested in from the above examples are:
#array = ("cat_dog","horse","rabbit","chicken-pig")
#array = ("elephant","MOUSE_RAT","spider","lion-tiger")
#array = ("ANTELOPE-GIRAFFE","frOG","fish","crab","kangaROO-KOALA")
The problem I am having:
I am trying to extract only the comma-separated strings from the variables and then store these in an array for use later on.
But what is the best way to make sure that I get the strings at the start (ie cat_dog) and end (ie chicken-pig) of the comma-separated list of animals as they are not prefixed/suffixed with a comma.
Also, as the variables will contain webpage content, it is inevitable that there may also be instances where a commas is immediately succeeded by a space and then another word, as that is the correct method of using commas in paragraphs and sentences...
For example:
Saturn was long thought to be the only ringed planet, however, this is now known not to be the case.
^ ^
| |
note the spaces here and here
I am not interested in any cases where the comma is followed by a space (as shown above).
I am only interested in cases where the comma DOES NOT have a space after it (ie cat_dog,horse,rabbit,chicken-pig)
I have a tried a number of ways of doing this but cannot work out the best way to go about constructing the regular expression.
How about
[^,\s]+(,[^,\s]+)+
which will match one or more characters that are not a space or comma [^,\s]+ followed by a comma and one or more characters that are not a space or comma, one or more times.
Further to comments
To match more than one sequence add the g modifier for global matching.
The following splits each match $& on a , and pushes the results to #matches.
my $str = "sdfds cat_dog,horse,rabbit,chicken-pig then some more pig,duck,goose";
my #matches;
while ($str =~ /[^,\s]+(,[^,\s]+)+/g) {
push(#matches, split(/,/, $&));
}
print join("\n",#matches),"\n";
Though you can probably construct a single regex, a combination of regexs, splits, grep and map looks decently
my #array = map { split /,/ } grep { !/^,/ && !/,$/ && /,/ } split
Going from right to left:
Split the line on spaces (split)
Leave only elements having no comma at the either end but having one inside (grep)
Split each such element into parts (map and split)
That way you can easily change the parts e.g. to eliminate two consecutive commas add && !/,,/ inside grep.
I hope this is clear and suits your needs:
#!/usr/bin/perl
use warnings;
use strict;
my #strs = ("ewrfs sdfdsf cat_dog,horse,rabbit,chicken-pig",
"fdsf iiukui aawwe dffg elephant,MOUSE_RAT,spider,lion-tiger hdsfds jdlkf sdf",
"dsadp poids pewqwe ANTELOPE-GIRAFFE,frOG,fish,crab,kangaROO-KOALA sdfdsf hkew",
"Saturn was long thought to be the only ringed planet, however, this is now known not to be the case.",
"Another sentence, although having commas, should not confuse the regex with this: a,b,c,d");
my $regex = qr/
\s #From your examples, it seems as if every
#comma separated list is preceded by a space.
(
(?:
[^,\s]+ #Now, not a comma or a space for the
#terms of the list
, #followed by a comma
)+
[^,\s]+ #followed by one last term of the list
)
/x;
my #matches = map {
$_ =~ /$regex/;
if ($1) {
my $comma_sep_list = $1;
[split ',', $comma_sep_list];
}
else {
[]
}
} #strs;
$var =~ tr/ //s;
while ($var =~ /(?<!, )\b[^, ]+(?=,\S)|(?<=,)[^, ]+(?=,)|(?<=\S,)[^, ]+\b(?! ,)/g) {
push (#arr, $&);
}
the regular expression matches three cases :
(?<!, )\b[^, ]+(?=,\S) : matches cat_dog
(?<=,)[^, ]+(?=,) : matches horse & rabbit
(?<=\S,)[^, ]+\b(?! ,) : matches chicken-pig

Regex to match vowels in order as they appear once

I trying to figure out a correct regex to match vowels in a word as they appear.
There may be any number of consonants in the word; however, there should be no other vowels other than the 5 listed above. For example, the word “sacrilegious” should not match because, although it contains the five vowels in alphabetical order, there is an extra ‘i’ vowel located between the ‘a’ and the ‘e’. Hyphenated words are not allowed. In fact, your regular expression should not match any ‘word’ that contains any character other than the upper and lower case letters.
Here are some words that it should match
abstemious
facetious
arsenious
acheilous
anemious
caesious
This is what I have come up with so far, but when I run the program it doesn't seem to be doing what it should do.
#!/usr/bin/perl -w
use strict;
my $test = "abstemious";
if( $test =~ /a[^eiou]*e[^aiou]*i[^aeou]*o[^aeiu]u/ )
{
print "yes";
}
You have a small typo there, try this:
/a[^eiou]*e[^aiou]*i[^aeou]*o[^aeio]*u/
You're not too far off. Try this regex:
/\b[b-df-hj-np-tv-z]*a[b-df-hj-np-tv-z]*e[b-df-hj-np-tv-z]*i[b-df-hj-np-tv-z]*o[b-df-hj-np-tv-z]*u[b-df-hj-np-tv-z]*\b/i
[b-df-hj-np-tv-z]* matches any number of consonants, then it's just slotting in the vowels and the word boundary markers (\b).
Try this regexp:
\b(?=[a-zA-Z]+)[^aA]*?[aA][^aeAE]*?[eE][^aeiAEI]*?[iI][^aeioAEIO]*?[oO][^aeiouAEIOU]*?[uU][^aeiouAEIOU]*?\b
Is it okay for a word to contain duplicate vowels, as long as they're in the correct order? For example, would faaceetiioouus (if there were such a word) be acceptable? I ask because your current regex does indeed match it.
If you want to match only words that contain exactly one of each vowel, try this:
/^
(?=[a-z0-9]+$)
[^aeiou]*a
[^aeiou]*e
[^aeiou]*i
[^aeiou]*o
[^aeiou]*u
[^aeiou]*
$
/ix
Here is another approach, if you don't mind making a temporary copy of the string:
use warnings;
use strict;
while (<DATA>) {
chomp;
my $test = $_;
my $cp = $test; # leave original string intact
$cp =~ tr/aeiou//cd;
print "$test\n" if $cp eq 'aeiou';
}
=for output
abstemious
facetious
arsenious
acheilous
anemious
caesious
=cut
__DATA__
abstemious
facetious
arsenious
acheilous
anemious
caesious
unabstemious
sacrilegious
intravenous
faaceetiioouus