VPF::Как обрезать строку до не разбивая слов

sir_nuf_nuf

Дата 5.10.2009, 14:06 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 1
Всего: 31

Товарищи, хочу предложить вам жизненную задачу на регулярки:

Задача проста:
Нужно обрезать строку до заданной длинны, стараясь по возможности не разбивать слова.
В конце строки нужно дописать троеточие (типа "есть продолжение")

Требование:
1) результат, вместе троеточием должен быть не длиннее указанной числа символов
2) не разбивать слова, т.е. обрезать предложение нужно между словю
3) между последним словом и троеточием не должно быть пробелов.

Я пока решил эту задачу на if - решил не извращаться с регуляркой.

Кто сможет написать regexp ?

--------------------

gcc

Дата 5.10.2009, 14:38 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: нет
Всего: 17

а что должно получиться?

вот например я делал обрезать длинные слова и длинные строки...

Код



sub stat_cut_big : Private {
    my ( $self, $c, $text_cut ) = @_;
    $text_cut ||= '';

    return length($text_cut) > 30 ? substr( $text_cut, 0, 30 ) : $text_cut;

}

sub stat_cut : Private {
    my ( $self, $c, $text_cut ) = @_;
    my $cut_hash;
    $text_cut ||= '';
        my $h;
    my @len = split( / /, $text_cut, 8 );
    my $big;
    foreach (@len) {
        if ( length($_) > 16 ) {
            $big = 1;
            # binmode(STDOUT,":utf8");
             $_ = Encode::decode('utf8', $_);

#use MIME::Base64;
# use Encode qw(_utf8_off);
#use utf8;
# $str = 'Текст в utf-8';
#_utf8_off($_);
#$_ = encode_base64($_, '');            
            
            $_ = substr $_, 0, 16;
            $_ .= '.. ';
          $_ = Encode::encode('utf8', $_ );

        }
    }

    return $big ? join( ' ', @len ) : $text_cut;

}

так вот вызвать:

Код


    $c->stash->{new_section_id1} = $loop_data->[0]->[0];
    $c->stash->{new_section_all1} =
      $c->forward( 'stat_cut_big', [ $loop_data->[0]->[1] ] );
    $c->stash->{new_section_cut1} =
      $c->forward( 'stat_cut', [ $loop_data->[0]->[1] ] );

Это сообщение отредактировал(а) gcc - 5.10.2009, 14:49

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

shamber

Дата 5.10.2009, 15:21 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: нет
Всего: 18

gcc, это регулярка?

Это сообщение отредактировал(а) shamber - 5.10.2009, 15:22

gcc

Дата 5.10.2009, 15:35 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: нет
Всего: 17

shamber, точно нет...

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

sir_nuf_nuf

Дата 5.10.2009, 16:01 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 1
Всего: 31

должно получиться примерно следующее:

Код


print wordcate("big bang theory",  13);
#bing bang...

--------------------

KSURi

Дата 5.10.2009, 19:21 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 887
Регистрация: 8.6.2006
Где: Russia

Репутация: нет
Всего: 27

Код


#!/usr/bin/evn perl

use Modern::Perl;

my @data = (
    'Hello World!',
    'This is very-very-very-very-very long string. Really long.',
    'This one is short.',
);
s{^.{0,13}\K\s.*$}{...} for @data;
say for @data

Легко можно сделать жадный вариант (нарушает п. 1, но на всякий случай):

Код


s{^.{13,}\K\s.*$}{...} for @data;

Это сообщение отредактировал(а) KSURi - 5.10.2009, 19:27

--------------------

Died at Life.pl line 21

sir_nuf_nuf

Дата 5.10.2009, 23:18 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 1
Всего: 31

KSURi, не работает.
видно на 'This is very-very-very-very-very long string. Really long.'

--------------------

amg

Дата 6.10.2009, 07:03 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1145
Регистрация: 3.8.2006
Где: Новосибирск

Репутация: нет
Всего: 50

Вот что я придумал (правда, не только регулярка, плюс к ней еще pos и пробелы в начале строки нужно удалять)

Код

my @data = ('
Hello!','
Hello World!','
This is very-very-very-very-very long string. Really long.','
This one is short.','
Very-very-very-very-very_long_word',
);

foreach (@data) {
  s/^\s+//;
  pos = 13-3;
  s/(?:\s+\S*|)\G.{4,}/.../;
  print length,": '$_'\n";
}

gcc

Дата 6.10.2009, 07:29 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: нет
Всего: 17

а почему нельзя написать без регулярки? регулярка быстрее будет?

просто пока это все понапридумывать - так очень много времени тратиться на это

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

KSURi

Дата 6.10.2009, 08:07 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 887
Регистрация: 8.6.2006
Где: Russia

Репутация: нет
Всего: 27

Цитата(sir_nuf_nuf @ 5.10.2009, 23:18

)

KSURi, не работает.
видно на 'This is very-very-very-very-very long string. Really long.'

Почему? У меня выводит "This is...".

UPD:
Нашел пару недочетов, поправил. Вроде не нарушает ниодного пункта.

Код


my $total_max = 13;
my $ending = '...';
my $meaning_max = $total_max - length $ending;
length > $total_max and s/^.{0,$meaning_max}\K[\s-].*$/$ending/ for @data;

Это сообщение отредактировал(а) KSURi - 6.10.2009, 08:30

--------------------

Died at Life.pl line 21

arto

Дата 6.10.2009, 14:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1495
Регистрация: 31.10.2004

Репутация: нет
Всего: 40

perl -le 'print $ARGV[0] =~ m#^(.{15,24}\S)\b# ? "$1..." : $ARGV[0]'

Logo

Дата 8.10.2009, 09:15 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 694
Регистрация: 22.7.2008

Репутация: 5
Всего: 10

А что считать словом? Машинное слово? Тогда:

Код


$_ = 'This is very-very-very-very-very long string. Really long.';
$maxn = 15;
$n = $maxn - 3;
m/^.{0,$n}\b(?=(?:\W|$))/;
print "$&...";

Цитата

Что бы развить моск. При тренировке регулярками как правило наоборот, время меньше тратится.

Это сообщение отредактировал(а) Logo - 8.10.2009, 13:11

amg

Дата 8.10.2009, 10:43 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1145
Регистрация: 3.8.2006
Где: Новосибирск

Репутация: нет
Всего: 50

Logo, а если
$_ = 'This_is_very_very_very_very_very_long_word.'; smile

Logo

Дата 8.10.2009, 13:10 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 694
Регистрация: 22.7.2008

Репутация: 5
Всего: 10

amg,
Можно добавить

Код


m/^.{0,$n}(?:\b(?=(?:\W|$))|^)/;

amg

Дата 8.10.2009, 15:37 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1145
Регистрация: 3.8.2006
Где: Новосибирск

Репутация: нет
Всего: 50

Цитата(Logo @ 8.10.2009, 13:10

)

Можно добавить...

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

Кроме того, пусть, например, строка содержит ровно $maxn символов. Твоё решение такую строку обрежет. А логично было бы оставить ее как есть -- она же помещается.

И к совсем коротким словам добавит ... Еще одну проверку? (В условии то сказано "только регуляркой". Хотя этого никто пока не смог соблюсти).

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Регулярные выражения \| Следующая тема »