Say i have a string "mg_delay_1_2_it" , whereby i can have varying sequence of the numbers separated by "_" i.e i can have also a string like "mg_delay_1_2_10_it", or "mg_delay_1_2_5_25_30_it". I want to be able to replace the number section with a single number to produce several versions example:
If the string is:mg_delay_1_2_5_25_30_it,
i want to be able to produce mg_delay_1_it ,mg_delay_2_it, mg_delay_5_it ,mg_delay_25_it and mg_delay_30_it from the original string.
Please how do i do this efficiently in perl?
Try this:
use strict;
use warnings;
use Data::Dumper;
my $str = 'mg_delay_1_2_5_25_30_it';
my $start = 'mg_delay';
my $end = 'it';
if (my ($res) = $str =~ /\Q$start\E_((?:\d+_)+)\Q$end\E/) {
my #items = $res =~ /(\d+)/g;
my #versions = map { $start . '_' . $_ . '_' . $end } #items;
print Dumper(\#versions);
}
Output:
$VAR1 = [
'mg_delay_1_it',
'mg_delay_2_it',
'mg_delay_5_it',
'mg_delay_25_it',
'mg_delay_30_it'
];
Alternatively, if $start and $end are not known:
my $str = 'mg_delay_1_2_5_25_30_it';
if (my ($start, $res, $end ) = $str =~ /^((?:(?!_\d).)+)_((?:\d+_)+)(.+)$/) {
my #items = $res =~ /(\d+)/g;
my #versions = map { $start . '_' . $_ . '_' . $end } #items;
print Dumper(\#versions);
}
Related
How could I add dynamically a modifier to a substitution?
my $str = 'aaBaabaabaa';
my $mod = 'g';
$str =~ s/b// + $mod;
qr/(?X:).../ doesn't work for operation-only modifiers like /g.
A possible approach would be:
#!/usr/bin/perl
use strict;
use warnings;
my $str = 'aaBaabaabaa';
print "BEFORE: ${str}\n";
# regex configuration
my $pattern = '(.)(.)'; # 'b';
my $replacement = '"$2$1"'; # '';
my $mod = 'ieg'; # 'g';
# extract operation-only modifiers
my $operation_only = qr/([ge])/;
my %special;
$special{$_}++ foreach ($mod =~ /$operation_only/g);
my $mod_filtered;
($mod_filtered = $mod) =~ s/$operation_only//g;
# generate regex
my $regex = "(?${mod_filtered}:${pattern})";
my $compiled = qr/$regex/;
print "s/ ${regex} -> ${compiled} / ${replacement} / $mod -> ", join('', sort keys %special), "\n";
# execute substitution
my $replacement_code = sub { return $replacement };
for (1..$special{e} // 0) {
my $recurse = $replacement_code;
$replacement_code = sub { return eval $recurse->() };
}
if (exists $special{g}) {
$str =~ s/$compiled/$replacement_code->()/ge;
} else {
$str =~ s/$compiled/$replacement_code->()/e;
}
print "AFTER: ${str}\n";
exit 0;
Output:
$ perl dummy.pl
BEFORE: aaBaabaabaa
s/ (?i:(.)(.)) -> (?^:(?i:(.)(.))) / "$2$1" / ieg -> eg
AFTER: aaaBbaaaaba
I would like to create a program that replaces characters and retains the special characters. An example input and output is shown below.
Here's what I did so far:
$sentence = userinput;
#words = split(/ /, $sentence);
for ($i = 0; $i < #words.length; $i ++){
$words[$i] =~ s/\W//g;
#characters = split(//, $words[$i]);
#print $words[$i] . "\n";
$wordlength = length($words[$i]);
for ($j = 0; $j < #characters.length; $j ++){
$char = $characters[$j];
for ($x = 0; $x < $wordlength; $x++){
$char++;
if ($char eq "aa"){
$char = "a";
}
elsif ($char eq "AA"){
$char = "A";
}
}
print $char;
if ($x = 0){
$output[$i] = $char;
}
else {
$output[$i] = join ($char);
}
}
print $output[$i];
}
Input:
Hi! how are you doing?
Output:
Jk! krz duh brx itnsl?
A couple of things in your code don't make sense:
Missing use strict; use warnings;.
All variables are global (you should be using my to create variables)
#foo.length is not the number of elements in the array #foo. It's the number of elements in the array #foo concatenated with the number of characters in $_ (because arrays in scalar context return their length, . concatenates strings, and length works on $_ by default).
join ($char) always returns the empty string: You're joining an empty list (no elements) using $char as a separator.
Here's an attempt to fix all of these issues:
use strict;
use warnings;
my $sentence = readline;
$sentence =~ s{([A-Za-z]+)}{
my $word = $1;
join '', map {
my $base = ord(/^[A-Z]/ ? 'A' : 'a');
chr((ord($_) - $base + length($word)) % 26 + $base)
} split //, $word
}eg;
print $sentence;
I think what you are doing is rot3 encoding, but if so then your example is wrong
my $sentence = 'Hi! how are you doing?';
$sentence =~ tr/A-Za-z/D-ZA-Cd-za-c/;
print $sentence, "\n";
output
Kl! krz duh brx grlqj?
which is similar, but not identical to
Jk! krz duh brx itnsl?
Need some help, not grasping a solution here on what method I should use.
I need to scan a directory and obtain the filenames by order of
1.YYYY-MM-DD, YYYY-MM-DD is part of the filename.
2. Machinename which is at the start of the filename to the left of the first "."
For example
Machine1.output.log.2014-02-26
Machine2.output.log.2014-02-27
Machine2.output.log.2014-02-26
Machine2.output.log.2014-02-27
Machine3.output.log.2014-02-26
So that it outputs in an array as follows
Machine1.output.log.2014-02-26
Machine2.output.log.2014-02-26
Machine3.output.log.2014-02-26
Machine1.output.log.2014-02-27
Machine2.output.log.2014-02-27
Thanks,
Often, temporarily turning your strings into a hash or array for sorting purposes, and then turning them back into the original strings is the most maintainable way.
my #filenames = qw/
Machine1.output.log.2014-02-26
Machine2.output.log.2014-02-27
Machine2.output.log.2014-02-26
Machine2.output.log.2014-02-27
Machine3.output.log.2014-02-26
/;
#filenames =
map $_->{'orig_string'},
sort {
$a->{'date'} cmp $b->{'date'} || $a->{'machine_name'} cmp $b->{'machine_name'}
}
map {
my %attributes;
#attributes{ qw/orig_string machine_name date/ } = /\A(([^.]+)\..*\.([^.]+))\z/;
%attributes ? \%attributes : ()
} #filenames;
You can define your own sort like so ...
my #files = (
"Abc1.xxx.log.2014-02-26"
, "Abc1.xxx.log.2014-02-27"
, "Abc2.xxx.log.2014-02-26"
, "Abc2.xxx.log.2014-02-27"
, "Abc3.xxx.log.2014-02-26"
);
foreach my $i ( #files ) { print "$i\n"; }
sub bydate {
(split /\./, $a)[3] cmp (split /\./, $b)[3];
}
print "sort it\n";
foreach my $i ( sort bydate #files ) { print "$i\n"; }
You can take your pattern 'YYYY-MM-DD' and match it to what you need.
#!/usr/bin/perl
use strict;
opendir (DIRFILES, ".") || die "can not open data file \n";
my #maplist = readdir(DIRFILES);
closedir(MAPS);
my %somehash;
foreach my $tmp (#maplist) {
next if $tmp =~ /^.{1,2}$/;
next if $tmp =~ /test/;
$tmp =~ /(\d{4})-(\d{2})-(\d{2})/;
$somehash{$tmp} = $1 . $2 . $3; # keep the original file name
# allows for duplicate dates
}
foreach my $tmp (keys %somehash) {
print "-->", $tmp, " --> " , $somehash{$tmp},"\n";
}
my #list= sort { $somehash{$a} <=> $somehash{$b} } keys(%somehash);
foreach my $tmp (#list) {
print $tmp, "\n";
}
Works, tested it with touch files.
I'm having a problem with a task similar to this one:
click (translated) (the one I was assigned with has way bigger tests and a lower time limit). A quick translation of the task:
Write a program that checks how many times the given number occurred in a given sequence.
Input: Given number, how many numbers are in the sequence, the sequence of numbers
Output: The number of occurrences
My solutions so far:
1:
#!/usr/bin/env perl
while (<>) {
$in = $_;
#nums = split / /, $in, 3;
$what = shift #nums;
shift #nums;
$rest = shift #nums;
$rest = " ".$rest." ";
$sum = () = $rest =~ /(?<=\s)$what(?=\s)/g;
print $sum;
print "\n";
}
2:
#!/usr/bin/env perl
while (<>) {
$in = $_;
#nums = split / /, $in, 3;
$what = shift #nums;
shift #nums;
$rest = shift #nums;
$rest = " ".$rest." ";
if(!$reg{$what}){
$reg{$what} = qr/(?<=\s)$what(?=\s)/;
}
$sum = () = $rest =~ /$reg{$what}/g;
print $sum;
print "\n";
}
I also tried the brute force approach, hash tables, grep... All exceed the given time limit, and I've got no idea how to write anything that will work faster than the above two. Any ideas?
edit: After getting rid of copying lists (turns out the numbers can also be negative):
#!/usr/bin/env perl
while ($line = <>) {
$line =~ s/^(-?\d+) \d+//;
$what = $1;
$sum = () = $line =~ / $what\b/g;
print $sum;
print "\n";
}
edit2: via http://www.chengfu.net/2005/10/count-occurrences-perl/:
print $sum = (($line =~ s/ $1\b//g)+0);
resulted in 2x faster code than:
print $sum = () = $line =~ / $1\b/g;
Works now, thanks :)
For one thing, you're doing an awful lot of copying. I've marked each time you copy a large string in your first example:
while (<>) {
$in = $_; # COPY
#nums = split / /, $in, 3; # COPY
$what = shift #nums;
shift #nums;
$rest = shift #nums; # COPY
$rest = " ".$rest." "; # COPY
$sum = () = $rest =~ /(?<=\s)$what(?=\s)/g;
print $sum;
print "\n";
}
To speed things up, avoid the copies. For example, use while ($in = <>) (or just skip $in and use $_).
For extracting $what and the count, I think I'd try this instead of split:
$in =~ s/^(\d+) \d+//;
$what = $1;
Instead of adding a space fore and aft, just use \b instead of lookarounds with \s.
$sum = () = $in =~ /\b$what\b/g;
Very new here so be gentle. :)
Here is the jist of what I want to do:
I want to take a string that is made up of numbers separated by semi-colons (ex. 6;7;8;9;1;17;4;5;90) and replace every "X" number of semicolons with a "\n" instead. The "X" number will be defined by the user.
So if:
$string = "6;7;8;9;1;17;4;5;90";
$Nth_number_of_semicolons_to_replace = 3;
The output should be:
6;7;8\n9;1;17\n4;5;90
I've found lots on changing the Nth occurrence of something but I haven't been able to find anything on changing every Nth occurrence of something like I am trying to describe above.
Thanks for all your help!
use List::MoreUtils qw(natatime);
my $input_string = "6;7;8;9;1;17;4;5;90";
my $it = natatime 3, split(";", $input_string);
my $output_string;
while (my #vals = $it->()) {
$output_string .= join(";", #vals)."\n";
}
Here is a quick and dirty answer.
my $input_string = "6;7;8;9;1;17;4;5;90";
my $count = 0;
$input_string =~ s/;/++$count % 3 ? ";" : "\n"/eg;
Don't have time for a full answer now, but this should get you started.
$string = "6;7;8;9;1;17;4;5;90";
$Nth_number_of_semicolons_to_replace = 3;
my $regexp = '(' . ('\d+;' x ($Nth_number_of_semicolons_to_replace - 1)) . '\d+);';
$string =~ s{ $regexp ) ; }{$1\n}xsmg
sub split_x{
my($str,$num,$sep) = #_;
return unless defined $str;
$num ||= 1;
$sep = ';' unless defined $sep;
my #return;
my #tmp = split $sep, $str;
while( #tmp >= $num ){
push #return, join $sep, splice #tmp, 0, $num;
}
push #return, join $sep, #tmp if #tmp;
return #return;
}
print "$_\n" for split_x '6;7;8;9;1;17;4;5;90', 3
print join( ',', split_x( '6;7;8;9;1;17;4;5;90', 3 ) ), "\n";
my $string = "6;7;8;9;1;17;4;5;90";
my $Nth_number_of_semicolons_to_replace = 3;
my $num = $Nth_number_of_semicolons_to_replace - 1;
$string =~ s{ ( (?:[^;]+;){$num} [^;]+ ) ; }{$1\n}gx;
print $string;
prints:
6;7;8
9;1;17
4;5;90
The regex explained:
s{
( # start of capture group 1
(?:[^;]+;){$num} # any number of non ';' characters followed by a ';'
# repeated $num times
[^;]+ # any non ';' characters
) # end of capture group
; # the ';' to replace
}{$1\n}gx; # replace with capture group 1 followed by a new line
If you've got 5.10 or higher, this could do the trick:
#!/usr/bin/perl
use strict;
use warnings;
my $string = '1;2;3;4;5;6;7;8;9;0';
my $n = 3;
my $search = ';.*?' x ($n -1);
print "string before: [$string]\n";
$string =~ s/$search\K;/\n/g;
print "print string after: [$string]\n";
HTH,
Paul