Perl Parse неправильно форматированный текст

Question

У меня есть строка текста, разбитая на фразы, каждая фраза заключена в квадратные скобки:

[pX textX/labelX] [pY textY/labelY] [pZ textZ/labelZ] [textA/labelA]

Иногда порция не начинается с символа p (как последний из приведенных выше).

Моя проблема в том, что мне нужно захватить каждый кусок. Это нормально при нормальных обстоятельствах, но иногда этот ввод неверно отформатирован, например, у некоторых фрагментов может быть только одна скобка или нет. Так это может выглядеть так:

 [pX textX/labelX] pY textY/labelY] textZ/labelZ

Но должно получиться так:

 [pX textX/labelX] [pY textY/labelY] [textZ/labelZ]

Проблема не включает вложенные скобки. После погружения в множество различных решений regex, как никогда раньше (я новичок в regex), загрузки таблиц и получения инструмента Regex (Expresso), я все еще не знаю, как это сделать. Есть идеи? Может быть, регулярное выражение не работает. Но как решить эту проблему? Я полагаю, что это не очень уникальная проблема.

Редактировать

Вот конкретный пример:

$data= "[VP sysmH/VBD_MS3] [PP ll#/IN_DET Axryn/NNS_MP] ,/PUNC w#hm/CC_PRP_MP3] [NP AEDA'/NN] ,/PUNC [PP b#/IN m$Arkp/NN_FS] [NP >HyAnA/NN] ./PUNC";

Это отличное компактное решение от @FailedDev:

while ($data =~ m/(?:\[[^[]*?\]|[^[ ].*?\]|\[[^[ ]*)/g) { # matched text = $& }

но я думаю, что для акцентирования проблемы нужно добавить два пункта:

1. у некоторых кусков вообще нет скобок
2. , / PUNC и w # hm / CC_PRP_MP3] - это отдельные фрагменты, которые необходимо разделить.

Однако, поскольку этот случай является фиксированным (т. Е. Метка PUNCTUATION, за которой следует шаблон текста / метки, который имеет только одну квадратную скобку справа), я как бы жестко закодировал его в решении, подобном этому:

my @stuff;
while ($data =~ m/(?:\[[^[]*?\]|[^[ ].*?\]|\[[^[ ]*)/g) {
    if($& =~ m/(^[\S]\/PUNC )(.*\])/) # match a "./PUNC" mark followed by a "phrase]"
    {
        @bits = split(/ /,$&); # split by space
        push(@stuff, $bits[0]); # just grab the first chunk before space, a PUNC
        push(@stuff, substr($&, 7)); # after that space is the other chunk
    }
    else { push(@stuff, $&); } 
}
foreach(@stuff){ print $_; }

При использовании примера, который я добавил в редактировании, это работает просто отлично, за исключением одной проблемы. Последний ./PUNC пропускается, поэтому вывод:

[VP sysmH/VBD_MS3]
[PP ll#/IN_DET Axryn/NNS_MP]
,/PUNC
w#hm/CC_PRP_MP3]
[NP AEDA'/NN]
,/PUNC
[PP b#/IN m/NN_FS]
[NP >HyAnA/NN]

Как мне сохранить последний кусок?

Answer 1

Вы можете использовать это

/(?:\[[^[]*?]|[^[ ].*?]|\[[^[ ]*)/

Предполагается, что ваша строка выглядит примерно так:

[pX textX/labelX] pY textY/labelY]  pY textY/labelY]  pY textY/labelY]  [pY textY/labelY] [3940-823490-2 [30-94823049 [32904823498]

Это не будет работать, например: pY [[[textY/labelY]

Специальное решение для Perl:

while ($subject =~ m/(?:\[[^[]*?\]|[^[ ].*?\]|\[[^[ ]*)/g) {
    # matched text = $&
}

Обновление:

/(?:\[[^[]*?]|[^[ ].*?]|\[[^[ ]*|\s+[^[]+?(?:\s+|$))/

Это работает с вашей обновленной строкой, но вы должны урезать пробел в результатах, если вам нужно.

Обновление: 2

/(\[[^[]*?]|[^[ ].*?]|\[[^[ ]*|\s*[^[]+?(?:\s+|$))/

Я предлагаю открыть другой вопрос, потому что ваш оригинальный вопрос полностью отличается от предыдущего.

"
(                 # Match the regular expression below and capture its match into backreference number 1
                     # Match either the regular expression below (attempting the next alternative only if this one fails)
      \[                # Match the character “[” literally
      [^[]              # Match any character that is NOT a “[”
         *?                # Between zero and unlimited times, as few times as possible, expanding as needed (lazy)
      ]                 # Match the character “]” literally
   |                 # Or match regular expression number 2 below (attempting the next alternative only if this one fails)
      [^[ ]             # Match a single character NOT present in the list “[ ”
      .                 # Match any single character that is not a line break character
         *?                # Between zero and unlimited times, as few times as possible, expanding as needed (lazy)
      ]                 # Match the character “]” literally
   |                 # Or match regular expression number 3 below (attempting the next alternative only if this one fails)
      \[                # Match the character “[” literally
      [^[ ]             # Match a single character NOT present in the list “[ ”
         *                 # Between zero and unlimited times, as many times as possible, giving back as needed (greedy)
   |                 # Or match regular expression number 4 below (the entire group fails if this one fails to match)
      \s                # Match a single character that is a “whitespace character” (spaces, tabs, line breaks, etc.)
         *                 # Between zero and unlimited times, as many times as possible, giving back as needed (greedy)
      [^[]              # Match any character that is NOT a “[”
         +?                # Between one and unlimited times, as few times as possible, expanding as needed (lazy)
      (?:               # Match the regular expression below
                           # Match either the regular expression below (attempting the next alternative only if this one fails)
            \s                # Match a single character that is a “whitespace character” (spaces, tabs, line breaks, etc.)
               +                 # Between one and unlimited times, as many times as possible, giving back as needed (greedy)
         |                 # Or match regular expression number 2 below (the entire group fails if this one fails to match)
            $                 # Assert position at the end of the string (or before the line break at the end of the string, if any)
      )
)
"

Answer 2

Это, по сути, та же самая процедура, которую я применил к вашей предыдущей задаче , я просто немного изменил map:

#!/usr/bin/perl

use strict;
use warnings;

my $string= "[VP sysmH/VBD_MS3] [PP ll#/IN_DET Axryn/NNS_MP] ,/PUNC w#hm/CC_PRP_MP3] [NP AEDA'/NN] ,/PUNC [PP b#/IN m\$Arkp/NN_FS] [NP >HyAnA/NN] ./PUNC";

my @items = split(/(\[.+?\])/, $string);

my @new_items = map { 
                     if (/^\[.+\]$/) { # items in []
                        $_;
                     } 
                     elsif (/\s/) {
                        grep m/\w/, split(/\s+/); # use grep to eliminate the split results that are the empty string
                     }
                     else { # discard empty strings
                     }
                    } @items;

print "--$_--\n" for @new_items;

Вывод, который вы получаете, это (дефисы служат только для иллюстрации отсутствия пробелов в начале / конце):

--[VP sysmH/VBD_MS3]--
--[PP ll#/IN_DET Axryn/NNS_MP]--
--,/PUNC--
--w#hm/CC_PRP_MP3]--
--[NP AEDA'/NN]--
--,/PUNC--
--[PP b#/IN m$Arkp/NN_FS]--
--[NP >HyAnA/NN]--
--./PUNC--

Я думаю, что это именно тот результат, который вы хотели получить.Я не знаю, будете ли вы удовлетворены решением «не только для регулярных выражений» ...

Answer 3

s{
   \[?
   (?: ([^\/]\s]+) \s+ )?
   ([^\]/\s]+)
   /
   ([^\]/\s]+)
   \]?
}{
   '[' .
   ( defined($1) ? "$1 " : '' ) .
   $2 .
   '/' .
   $3 .
   ']'
}xeg;