Finding and replacing patterns in a string

My string

(champs1 (champs6 donnee_o donnee_f) [(champs2 [] (champs3 _YOJNJeyyyyyyB (champs4 donnee_x)) (debut 144825 25345) (fin 244102 40647)), (champs2 [] (champs3 _FuGNJeyyyyyyB (champs4 donnee_z)) (debut 796443 190570) (fin 145247 42663))] [] []).

      

(Annotated for readability):

(champs1 
     (champs6 donnee_o donnee_f) 
     [(champs2 [] 
          (champs3 _YOJNJeyyyyyyB (champs4 donnee_x)) 
          (debut 144825 25345)
          (fin 244102 40647)
       ), 
      (champs2 [] 
          (champs3 _FuGNJeyyyyyyB (champs4 donnee_z)) 
          (debut 796443 190570) 
          (fin 145247 42663)
     )] 
     [] 
     []
).

      

In the above line, I would like to replace the integer values ​​accordingly with these values:

$moyLargRectNom, $moyHautRectNom, $moyLargRectNom, 
$moyHautRectNom, $moyLargRectMat, $moyHautRectMat, 
$moyLargRectMat, $moyHautRectMat

      

I have 8 replacement values ​​in a string.

This is my REGEX

$ligne =~ s{
    (.*debut) \s\d+ \s\d+
    (.*fin)   \s\d+ \s\d+
    (.*debut) \s\d+ \s\d+
    (.*fin)   \s\d+ \s\d+
    (.*)
}{
    $1 . $moyLargRectNom . 
    $2 . $moyHautRectNom . 
    $3 . $moyLargRectNom . 
    $4 . $moyHautRectNom . 
    $5 . $moyLargRectMat . 
    $6 . $moyHautRectMat . 
    $7 . $moyLargRectMat . 
    $8 . $moyHautRectMat . 
    $9
}xe;

      

It does not replace values ​​at all; Can anyone help me? Thanks.

0


a source to share


4 answers


Try this for size:

my @numbers = ($moyLargRectNom, $moyHautRectNom, $moyLargRectNom, $moyHautRectNom, $moyLargRectMat, $moyHautRectMat, $moyLargRectMat, $moyHautRectMat);
my @temp = split / /, $ligne;
for(@temp) {
  if(/^\W*\d\W*$/) {
    my $num = shift @numbers;
    s/\d+/$num/;
  }
}
$ligne = join " ", @temp;

      

@temp

, "" () $ligne

. @numbers

, , , , . @temp

, , (.. /^\W*\d\W*$/

, , ( "champs4" ) - "25346" ) "25346" ), @numbers

. , , , !

I believe a shorter implementation can be achieved with map

, but that will be good enough for you.

The benefits of this approach to your approach:

First, the solution is scalable. To replace more than eight numbers with your solution, you need to write a new regex. To replace more than eight numbers with my solution, just add some more entries in @numbers

. You can put this code in a subroutine where you want to change the line and also change the list of numbers, so you don't have to worry about whether they were passing in the correct number of numbers or if they are in the correct format.

Second, it's a little easier to understand at a glance. Regular expressions, while the one you used, are very difficult to parse visually. Even if it works, someone might need to modify their code to do something different. If you're using a huge rewritten rewriter (you might) just shake your head, highlight your code and hit delete, then write new code to do that. This allows them to easily see what's going on in your code, and if they need to make changes to it, they can.



Third, if you want to hard-code the specified number of replacements to do this, you can also do this:

my @numbers = ($moyLargRectNom, $moyHautRectNom, $moyLargRectNom, $moyHautRectNom, $moyLargRectMat, $moyHautRectMat, $moyLargRectMat, $moyHautRectMat);
my @temp = split / /, $ligne;
my $max_replacements = 8;
for(@temp) {
  if(/^\W*\d\W*$/) {
    my $num = shift @numbers;
    s/\d+/$num/;
    last unless --$max_replacements;
  }
}
$ligne = join " ", @temp;

      

As a side note (which applies earlier, but still applies), this won't work with floating point numbers - /^\W*\d\W*$/

will match floating point numbers, but s/\d+/$num/

won't replace floating point numbers, only the integer part.If you find you need floating point numbers, change this line:

s/\d+/$num/;

      

For this:

s/\d+|(?:\d+)?\.\d+/$num/;

      

This should match floating point numbers.

+1


a source


sprintf for help:



#!/usr/bin/perl

use strict;
use warnings;

my $s = <<EO_TXT;
(champs1 (champs6 donnee_o donnee_f) [(champs2 [] 
(champs3 _YOJNJeyyyyyyB (champs4 donnee_x)) (debut 144825 25345) 
(fin 244102 40647)), (champs2 [] (champs3 _FuGNJeyyyyyyB 
(champs4 donnee_z)) (debut 796443 190570) (fin 145247 42663))] [] []).
EO_TXT

my ( 
    $moyLargRectNom, $moyHautRectNom, 
    $moyLargRectMat, $moyHautRectMat, 
) = map { "val$_" } qw( 1 2 3 4 );

my @replacements = (
    $moyLargRectNom, $moyHautRectNom,
    $moyLargRectNom, $moyHautRectNom,
    $moyLargRectMat, $moyHautRectMat,
    $moyLargRectMat, $moyHautRectMat,
);

$s =~ s/\b[0-9]+\b/%s/g; # replace %s with the appropriate specifier
$s = sprintf $s, @replacements;

print $s, "\n";

      

+1


a source


You seem to be doing it the other way around, as I am. I would look for numbers and replace them, not what you doig, i.e. matching the stuff surrounding the numbers and replacing them with a string.

Will there ALWAYS be 8 values? Will they always follow the same words? If yes:

.+?debut\s([\d]+)\s([\d]+).+?fin\s([\d]+)\s([\d]+).+?debut\s([\d]+)\s([\d]+).+?fin\s([\d]+)\s([\d]+)

      

or can debut and finale appear anywhere, and whenever they do, you want to replace them as such:

debut xy → debut $ moyLargRectNom, $ moyHautRectNom, fin xy → fin $ moyLargRectNom, $ moyHautRectNom, (debut 144825 25345) (fin 244102 40647)

if that's true, just do it using two simple regular expressions:

debut\s([\d]+)\s([\d]+)
fin\s([\d]+)\s([\d]+)

      

and replace the groups with words ..

but I can't remember which variable stores the number of groups created, sorry.

0


a source


I realized that your structure is too irregular or weird to match a regex, nested expressions are rare.

So, I went looking for the parse tree. Not finding one that fits, and not understanding any formal parsing grammars, I wrote my own tokenizer / state machine.

It turns your code into a data tree that can then be retrieved using simple loop constructs.

Beware , the code is only meant to work with your small dataset provided so far, unbalanced parentheses give parser headaches and create a useless tree.

Uncheck below to see how to use this blob

#!/usr/bin/perl 

use strict;
use warnings;
use version;
use Data::Dumper;
our $VERSION = qv('0.1');

my @stack;

my $data = <<'EOF';
(champs1 
     (champs6 donnee_o donnee_f) 
     [(champs2 [] 
          (champs3 _YOJNJeyyyyyyB (champs4 donnee_x)) 
          (debut 144825 25345)
          (fin 244102 40647)
       ), 
      (champs2 [] 
          (champs3 _FuGNJeyyyyyyB (champs4 donnee_z)) 
          (debut 796443 190570) 
          (fin 145247 42663)
     )] 
     [] 
     []
)
EOF

push @stack,
  {
    tokens  => [],
    context => 'void',
  };

my $state;

my $eaten;
my $str = $data;

sub eat
{
    my $n = shift;
    substr( $str, 0, $n, '' );
}

while ( @stack && $str )
{
    $state = $stack[-1];
    my @tokens  = @{ $stack[-1]->{tokens} };
    my $context = $stack[-1]->{context};

    if ( $str =~ m{(^[\s,]+)} )
    {
        eat length($1);
        next;
    }
    if ( $str =~ m{(^\w+)} )
    {
        eat length($1);
        push @{ $stack[-1]->{tokens} }, $1;
        next;
    }
    if (    $str =~ m{^\[}
        and $context eq 'nest'
        || $context  eq 'nestgroup'
        || $context  eq 'array' )
    {
        eat 1;
        print "\e[33m[\e[0m";
        push @stack,
          {
            tokens  => [],
            context => 'array',
          };

        next;
    }

    if ( $str =~ m{^\]} and $context eq 'array' )
    {
        eat 1;
        print "\e[33m]\e[0m";
        pop @stack;
        push @{ $stack[-1]->{tokens} }, \@tokens;
        next;
    }

    if (
        $str =~ m{^\((champs(\d)|debut|fin)\s}
        and (  $context eq 'nest'
            || $context eq 'array'
            || $context eq 'nestgroup'
            || $context eq 'void' )
      )
    {
        eat length($1) + 1;
        $stack[-1]->{nodename} = $1;
        print "\e[32m($1\e[0m";
        push @stack,
          {
            tokens  => [],
            context => 'nestgroup',
          };
        next;
    }
    if ( $str =~ m{^\)} and $context eq 'nestgroup' )
    {
        eat 1;
        print "\e[32m)\e[0m";
        pop @stack;
        my $nodename = $stack[-1]->{nodename};
        push @{ $stack[-1]->{tokens} }, { $nodename, \@tokens };
        next;
    }
    if ( $str =~ m{^\(} )
    {
        eat 1;
        print "\e[31m(\e[0m";
        push @stack,
          {
            tokens  => [],
            context => 'nest',
          };
        next;
    }
    if ( $str =~ m{^\)} and $context eq 'nest' )
    {
        eat 1;
        print "\e[31m)\e[0m";
        pop @stack;
        push @{ $stack[-1]->{tokens} }, \@tokens;
        next;
    }

    print substr( $str, 0, 1 ), "\e[34m$context\e[0m";
    eat 1;
}

$Data::Dumper::Indent = 1;
$Data::Dumper::Terse  = 1;

print "Tree:\n";
print Dumper( $state->{tokens}->[0]->{champs1}->[1] );

print "--------";
for ( @{ $state->{tokens}->[0]->{champs1}->[1] } )
{
    my @data = @{ $_->{champs2} };
    print ">", Dumper( $data[2], $data[3] );
}

      

Exit:

(champs1(champs6)[(champs2[](champs3(champs4))(debut)(fin))(champs2[](champs3(champs4))(debut)(fin))][][])
Tree:
[
  {
    'champs2' => [
      [],
      {
        'champs3' => [
          '_YOJNJeyyyyyyB',
          {
            'champs4' => [
              'donnee_x'
            ]
          }
        ]
      },
      {
        'debut' => [
          '144825',
          '25345'
        ]
      },
      {
        'fin' => [
          '244102',
          '40647'
        ]
      }
    ]
  },
  {
    'champs2' => [
      [],
      {
        'champs3' => [
          '_FuGNJeyyyyyyB',
          {
            'champs4' => [
              'donnee_z'
            ]
          }
        ]
      },
      {
        'debut' => [
          '796443',
          '190570'
        ]
      },
      {
        'fin' => [
          '145247',
          '42663'
        ]
      }
    ]
  }
]
--------
>{
  'debut' => [
    '144825',
    '25345'
  ]
}
{
  'fin' => [
    '244102',
    '40647'
  ]
}
>{
  'debut' => [
    '796443',
    '190570'
  ]
}
{
  'fin' => [
    '145247',
    '42663'
  ]
}

      

0


a source







All Articles