查找并替换字符串中的模式

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 string, i would like to replace the integer values, respectively by these values:

在上面的字符串中,我想分别用这些值替换整数值:

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

I've 8 values to replace in the string.

我在字符串中替换了8个值。

This is my REGEX

这是我的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 doesn't replace the values at all; can anyone help me please? Thank you.

它根本不取代价值观;有人可以帮我吗?谢谢。

4 个解决方案

#1

sprintf to the rescue:

sprintf救援:

#!/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";

#2

Try this out 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;

That makes a list, @temp, based on the "words" (approximately) in $ligne. It makes another list, @numbers, which is a list of the numbers you want to replace in the list, in the order you want them to replace things. Then it goes through @temp, one-by-one, and if a given element is a number (i.e. matches the regex /^\W*\d\W*$/, which means it has no word characters (so it's not "champs4") and has at least one number - this will match "25346)" in addition to "25346"), and then replace the numeric part with the first value from @numbers. And now that I've tested it, I can assure you this actually works!

这使得列表@temp基于$ ligne中的“大约”字样。它会生成另一个列表@numbers,它是您要在列表中替换的数字列表,按照您希望它们替换的顺序。然后它逐个通过@temp,如果一个给定的元素是一个数字(即匹配正则表达式/ ^ \ W * \ d \ W * $ /,这意味着它没有单词字符(所以它不是“champs4”)并且至少有一个数字 - 除了“25346”之外还匹配“25346”),然后用@numbers中的第一个值替换数字部分。现在我已经测试过,我可以向你保证这确实有效!

I believe a shorter implementation could be achieved with map, but this will work well enough for you.

我相信使用map可以实现更短的实现,但这对你来说效果会很好。

Advantages of this approach to your approach:

这种方法对您的方法的优势:

First, this solution is scalable. To replace more than eight numbers with your solution, you would need to write a new regex. To replace more than eight numbers with my solution, just add a few more entries to @numbers. This code could be put into a subroutine that takes a string to change and a list of numbers to change, and you wouldn't have to worry about whether or not they passed the right number of numbers, or whether they have the right format.

首先,该解决方案是可扩展的。要用您的解决方案替换八个以上的数字,您需要编写一个新的正则表达式。要使用我的解决方案替换八个以上的数字,只需在@numbers中添加几个条目即可。此代码可以放入一个子程序,该子程序需要更改字符串和要更改的数字列表,您不必担心它们是否传递了正确数量的数字,或者它们是否具有正确的格式。

Second, this is a bit easier to understand at cursory glance. Regexes as long as the one you were using are very hard to parse visually. Even if it works, someday someone may need to alter your code to do something different. If you use a huge regex, the rewriter (perhaps you) will simply shake their heads, highlight your code, and press delete, and then write new code to do it. With this, they can easily see what is happening in your code, and if they need to make modifications to it, they can.

其次,粗略一瞥就更容易理解了。只要您使用的正则表达式很难在视觉上解析。即使它有效,有一天有人可能需要改变你的代码来做一些不同的事情。如果你使用一个巨大的正则表达式,重写器(也许你)将只是摇头,突出你的代码,然后按删除,然后编写新的代码来执行它。有了这个,他们可以很容易地看到你的代码中发生了什么,如果他们需要对它进行修改,他们就可以。

Third, if you want to hardcode in a specified number of replacements to make, you can do that too:

第三,如果你想要在指定数量的替换中进行硬编码,你也可以这样做:

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 applied earlier, but still applies), this will fail on 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 discover you need floating point numbers, change this line:

作为旁注(之前应用,但仍然适用),这将失败浮点数 - / ^ \ W * \ d \ W * $ /将匹配浮点数,但s / \ d + / $ num / won不替换浮点数,只替换整数部分。如果您发现需要浮点数,请更改此行:

s/\d+/$num/;

To this:

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

That should match floating point numbers.

这应该匹配浮点数。

#3

You seem to be doing it the opposite way that I would. i.e i'd look for the numbers and replace those, rather than what you're donig, i.e., matching the the stuff surrounding the numbers and substituting them into a string.

你似乎正在以与我相反的方式做到这一点。即我会查找数字并替换那些数字,而不是替换它们,即匹配数字周围的东西并将它们代入字符串。

Will there ALWAYS be 8 values? Will they always follow the same words? if so:

总是会有8个值吗?他们会一直跟着同样的话吗?如果是这样:

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

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

或者可以在任何地方出现首次亮相和鳍片,无论什么时候你都想要替换它们:

debut x y -> debut $moyLargRectNom, $moyHautRectNom, fin x y -> fin $moyLargRectNom, $moyHautRectNom, (debut 144825 25345) (fin 244102 40647)

首次亮相x y - >首次亮相$ moyLargRectNom,$ moyHautRectNom,fin x y - > fin $ moyLargRectNom,$ moyHautRectNom,(首次亮相144825 25345)(fin 244102 40647)

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

如果这是真的,只需使用两个简单的正则表达式:

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

and replace the groups with the words..

并用单词替换组..

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

但我不记得哪个变量存储了创建的组数,抱歉。

#4

I figgured your structure was too irregular or strange to be suited for a regular expression, nested expressions rarely are.

我认为你的结构太不规则或奇怪,不适合正则表达式,嵌套表达式很少。

So I went in hunt of a parse-tree. Not finding one that suited, and not understanding any of the formal parse grammars, I wrote my own tokenister/state machine.

所以我去寻找一张解析树。找不到适合的,不理解任何正式的解析语法,我写了自己的令牌/状态机。

It turns your code into a data-tree which you can then extract with simple looping constructs.

它将您的代码转换为数据树,然后您可以使用简单的循环结构进行提取。

Beware, code is only designed to work on your small data-set provided so far, unbalanced brackets will give parser headaches and produce a useless tree.

请注意,代码仅用于处理目前提供的小数据集,不平衡的括号会给解析器带来麻烦并产生无用的树。

Skim to the bottom to see how to use this blob

撇去底部看看如何使用这个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] );
}

Output:

(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'
  ]
}