Удаление пробелов между отдельными буквами

Question

У меня есть строка, которая может содержать произвольное количество одинарных букв, разделенных пробелами. Я ищу регулярное выражение (в Perl), которое удалит пробелы между всеми (неизвестное число) отдельных букв.

Например:

ab c d должно стать ab cd

a bcd e f gh должно стать a bcd ef gh

a b c должно стать abc

и

abc d следует оставить без изменений (потому что нет ни одной буквы, за которой следует один пробел или перед которым стоит)

Спасибо за любые идеи.

Answer 1

Ваше описание не соответствует вашим примерам.Мне кажется, что вы хотите удалить любой пробел, которому (1) предшествует буква, которая сама по себе не предшествует букве, и (2) следует буква, за которой не следует буква.Эти условия могут быть выражены точно как вложенные обходные пути:

/(?<=(?<!\pL)\pL) (?=\pL(?!\pL))/

проверено:

use strict;
use warnings;

use Test::Simple tests => 4;

sub clean {
  (my $x = shift) =~ s/(?<=(?<!\pL)\pL) (?=\pL(?!\pL))//g;
  $x;
}

ok(clean('ab c d')        eq 'ab cd');
ok(clean('a bcd e f gh')  eq 'a bcd ef gh');
ok(clean('a b c')         eq 'abc');
ok(clean('ab c d')        eq 'ab cd');

вывод:

1..4
ok 1
ok 2
ok 3
ok 4

Я предполагаю, что вы действительно имели в виду один пробелсимвол (U + 0020);если вы хотите сопоставить любой пробел, вы можете заменить пробел на \s+.

Answer 2

Вы можете сделать это с помощью утверждений lookahead и lookbehind, как описано в perldoc perlre :

use strict;
use warnings;

use Test::More;

is(tran('ab c d'), 'ab cd');
is(tran('a bcd e f gh'), 'a bcd ef gh');
is(tran('a b c'), 'abc');
is(tran('abc d'), 'abc d');

sub tran
{
    my $input = shift;

    (my $output = $input) =~ s/(?<![[:lower:]])([[:lower:]]) (?=[[:lower:]])/$1/g;
    return $output;
}

done_testing;

Обратите внимание, что текущий код не выполняется во втором тестовом примере, так как вывод:

ok 1
not ok 2
#   Failed test at test.pl line 7.
#          got: 'abcd efgh'
#     expected: 'a bcd ef gh'
ok 3
ok 4
1..4
# Looks like you failed 1 test of 4.

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

Answer 3

Этот кусок кода

#!/usr/bin/perl

use strict;

my @strings = ('a b c', 'ab c d', 'a bcd e f gh', 'abc d');

foreach my $string (@strings) {
   print "$string --> ";
   $string =~ s/\b(\w)\s+(?=\w\b)/$1/g; # the only line that actually matters
   print "$string\n";
}

печатает это:

a b c --> abc
ab c d --> ab cd
a bcd e f gh --> a bcd ef gh
abc d --> abc d

Я думаю / надеюсь, это то, что вы ищете.

Answer 4

Это сделает работу.

(?<=\b\w)\s(?=\w\b)

Answer 5

Теперь у меня самый медленный и самый быстрый.

#!/usr/bin/perl
use 5.012;
use warnings;
use Benchmark qw(cmpthese);
my @strings = ('a b c', 'ab c d', 'a bcd e f gh', 'abc d');

cmpthese( 0, {
    Eric_Storm  => sub{ for my $string (@strings) { $string =~ s{\b(\w) ((?: \s+ (\w)\b)+)}{$1 . join '', split m|\s+|, $2}gex; } },
    canavanin   => sub{ for my $string (@strings) { $string =~ s/\b(\w)\s+(?=\w\b)/$1/g; } },
    Alan_Moore  => sub{ for my $string (@strings) { $string =~ s/(?<=(?<!\pL)\pL) (?=\pL(?!\pL))//g; } },
    keep_uni    => sub{ for my $string (@strings) { $string =~ s/\PL\pL\K (?=\pL(?!\pL))//g; } },
    keep_asc    => sub{ for my $string (@strings) { $string =~ s/[^a-zA-Z][a-zA-Z]\K (?=[a-zA-Z](?![a-zA-Z]))//g; } },
    no_regex    => sub{ for my $string (@strings) { my @s; my $t = ''; 
    for my $el (split /\s+/, $string) {if (length $el > 1) { push @s, $t if $t; $t = ''; push @s, $el; } else { $t .= $el; } }
    push @s, $t if $t;
    #say "@s";
    } },
});

.

           Rate  no_regex Alan_Moore Eric_Storm canavanin  keep_uni keep_asc                                                                                                                                                             
no_regex    98682/s        --       -64%       -65%      -66%      -81%     -87%                                                                                                                                                             
Alan_Moore 274019/s      178%         --        -3%       -6%      -48%     -63%                                                                                                                                                             
Eric_Storm 282855/s      187%         3%         --       -3%      -46%     -62%                                                                                                                                                             
canavanin  291585/s      195%         6%         3%        --      -45%     -60%
keep_uni   528014/s      435%        93%        87%       81%        --     -28%
keep_asc   735254/s      645%       168%       160%      152%       39%       --

Answer 6

Это не регулярное выражение, но так как я ленив по натуре, я бы так и сделал.

#!/usr/bin/env perl
use warnings;
use 5.012;

my @strings = ('a b c', 'ab c d', 'a bcd e f gh', 'abc d');
for my $string ( @strings ) {
    my @s; my $t = '';
    for my $el ( split /\s+/, $string ) {
        if ( length $el > 1 ) {
        push @s, $t if $t;
        $t = '';
        push @s, $el;
        } else { $t .= $el; }
    }
    push @s, $t if $t;
    say "@s";
}

ОК, мой путь самый медленный:

no_regex   130619/s         --       -60%       -61%       -63%
Alan_Moore 323328/s       148%         --        -4%        -8%
Eric_Storm 336748/s       158%         4%         --        -5%
canavanin  352654/s       170%         9%         5%         --

Я не включил код Эфира, потому что (как он проверял) он возвращает разные результаты.

Answer 7

Это должно сработать:

my $str = ...;

$str =~ s/ \b(\w) \s+ (\w)\b /$1$2/gx;

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

Как подсказывает Эфир, в одном случае это не получается. Вот версия, которая должна работать (хотя и не так чисто, как первая):

s/ \b(\w) ( (?:\s+ \w\b)+ ) /$1 . join '', split m|\s+|, $2/gex;

Мне понравился подход, основанный на тесте Эфира (подражание - самая искренняя форма лести и все такое):

use warnings;
use strict;
use Test::Magic tests => 4;

sub clean {
    (my $x = shift) =~ s{\b(\w) ((?: \s+ (\w)\b)+)}
                        {$1 . join '', split m|\s+|, $2}gex;
    $x
}

test 'space removal',
  is clean('ab c d')       eq 'ab cd',
  is clean('a bcd e f gh') eq 'a bcd ef gh',
  is clean('a b c')        eq 'abc',
  is clean('abc d')        eq 'abc d';

возвращается:

1..4
ok 1 - space removal 1
ok 2 - space removal 2
ok 3 - space removal 3
ok 4 - space removal 4