Perl - How to change every $variable occurrence of ";" in a string - perl

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

Related

How to separate an array in Perl based on pattern

I am trying to write a big script but I am stuck on a part. I want to sprit an array based on ".."
From the script I got this:
print #coordinates;
gene complement(872..1288)
my desired output:
complement 872 1288
I tried:
1) my #answer = split(.., #coordinates)
print("#answer\n");
2) my #answer = split /../, #coordinates;
3) print +(split /\../)[-1],[-2],[-3] while <#coordinates>
4) foreach my $anwser ( #coordinates )
{$anwser =~ s/../"\t"/;
print $anwser;}
5) my #answer = split(/../, "complement(872..1288)"); #to see if the printed array is problematic.
which prints:
) ) ) ) ) ) ) ) )
6) my #answer = split /"gene "/, #coordinates; # I tried to "catch" the entire output's spaces and tabs
which prints
0000000000000000000000000000000001000000000100000000
But none of them works. Does anyone has any idea how to step over this issue?
Ps, unfortunately, I can't run my script right now on Linux so I used this website to run my script. I hope this is not the reason why I didn't get my desired output.
my $RE_COMPLEMENT = qr{(complement)\((\d+)\.\.(\d+)\)}msx;
for my $item (#coordinates) {
my ($head, $i, $j) = $item =~ $RE_COMPLEMENT;
if (defined($head) && defined($i) && defined($j)) {
print("$head\t$i\t$j\n");
}
}
split operates on a scalar, not on an array.
my $string = 'gene complement(872..1288)';
my #parts = split /\.\./, $string;
print $parts[0]; # gene complement(872
print $parts[1]; # 1288)
To get the desired output, you can use a substitution:
my $string = 'gene complement(872..1288)';
$string =~ s/gene +|\)//g;
$string =~ s/\.\./ /;
$string =~ s/\(/ /;
Desired effect can be achieved with
use of tr operator to replace '(.)' => ' '
then splitting data string into element on space
storing only required part of array
output elements of array joined with tabulation
use strict;
use warnings;
use feature 'say';
my $data = <DATA>;
chomp $data;
$data =~ tr/(.)/ /;
my #elements = (split ' ', $data)[1..3];
say join "\t", #elements;
__DATA__
gene complement(872..1288)
Or as an alternative solution with only substitutions (without splitting data string into array)
use strict;
use warnings;
use feature 'say';
my $data = <DATA>;
chomp $data;
$data =~ s/gene\s+//;
$data =~ s/\)//;
$data =~ s/[(.]+/\t/g;
say $data;
__DATA__
gene complement(872..1288)
Output
complement 872 1288

How to replace a sequence of numbers separated by " _" in a string with a single number

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);
}

perl replace characters in a string but retain special character or space

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?

Speed problem with SPOJ occurence counting in perl

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;

How can I search and replace a match a specific number of times in a string in Perl?

How can I search and replace a match with specific number of times using s///;. For example:
$string="abcabdaaa";
I want to replace a with i in $string n times. How can I do that? n is an integer provided by user.
The simple answer probably doesn't do want you want.
my $str = 'aaaa';
$str =~ s/a/a_/ for 1..2;
print $str, "\n"; # a__aaa. But you want a_a_aa, right?
You need to count the replacements yourself, and act accordingly:
$str = 'aaaa';
my $n = 0;
$str =~ s/(a)/ ++$n > 2 ? $1 : 'a_' /ge;
print $str, "\n";
See the FAQ, How do I change the Nth occurrence of something? for related examples.
Just substitute $n times:
$string =~ s/a/i/ for 1..$n;
This will do it.
More general solution would be global substitution with counter:
my $i = 0; # count the substitutions made
$string =~ s/(a)/ ++$i > $n ? $1 : "i" /ge;
I'm not aware of any flag that would do that. I'd simply use a loop:
for (my $i = 0; $i < $n; $i++)
{
$string =~ s/a/i/;
}
you can try this:
$str1=join('i',split(/a/,$str,$n));
Here is a way to do based on the comment you made to eugene y's answer
#!/usr/bin/perl
use strict; use warnings;
my $string = '***ab***c';
my $n = 3;
1 while $n -- and $string =~ s/\*([^\n])/*\n$1/;
print "$string\n";
Output:
*
*
*
ab***c
Using
sub substitute_n {
my $n = shift;
my $pattern = shift;
my $replace = shift;
local $_ = shift;
my $i = 1;
s{($pattern)} {
$i++ <= $n ? eval qq{"$replace"} : $1;
}ge;
$_;
}
You can then write
my $s = "***ab***c";
print "[", substitute_n(2, qr/\*/, '$1\n', $s), "]\n";
to get the following output:
[*
*
*ab***c]