Модераторы: korob2001, ginnie
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Скрипт обрезки предложений по количеству слов 
:(
    Опции темы
viperson
Дата 8.3.2009, 13:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: -1
Привет всем!! Помогите пожалуйста нубу. 
Задача выглядит так:

Есть текстовый файл с  предложениями на английском языке по 1-3 предложения в строке.

- Необходимо сначала осуществить перенос предложений по точке на новую строку и удаление строк менее 5 слов

- Необходимо отсеять предложения в отдельный файл с обрезкой исходных предложений  (задается) по количеству слов  или по количеству пробелов в предложении.

- Необходимо чтобы скрипт работал на denwer

Буду очень признателен!  smile 

Это сообщение отредактировал(а) viperson - 8.3.2009, 13:36
PM   Вверх
amg
Дата 8.3.2009, 17:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 38
Всего: 50
Код

open IN,  '<', "file_in.txt"  or die $!;
open OUT, '>', "file_out.txt" or die $!;
$N = 6;
while (<IN>) {
  s/^\s+//;
  while (/(.+?\.)\s+/g) {
    ($sent = $1) =~ s/\s+/ /g;
    $sent .= ' ';
    next if $sent=~tr/ / / < 5;
    $sent =~ s/((?:\S+ ){$N}).*/$1/;
    print OUT "$sent\n";
  }
}
close IN;
close OUT;
Писал в форум, проверяйте. Под веб сами прилаживайте.


Это сообщение отредактировал(а) amg - 8.3.2009, 17:59
PM MAIL   Вверх
klem4
Дата 8.3.2009, 21:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: 2
Всего: 2
amg, ваш код дает не верный результат на файле

Код

qwe.lalala bla bla.
12345 xxx x x x. 1 2 3 4 5.
q w e r
a b c d e


Мой вариант (особо долго конечно тоже не тестировал ...)

Код

  open my $fin,  '<', 'file_in.txt';     # входной файл  
  open my $fout, '>', 'file_out.txt'; # выходной файл 

  my $cut = 2; # сколькол отрубаем 

  # считаем что на строчке нет незаконченных предложений 
  my $text = join "", <$fin>;  # читаем текст 
  $text =~ s/\./\.\n/mg;       # добавил переносы после точек.                 


  my @sentense = split /\n/, $text; # получи массив предложений 
  
  # удалим предложения, в которых < 5 слов 
  # здесь важно знать как могут разделяться слова, я использую стандартный разделитель - \b 
  for ( my $i = 0; $i <= $#sentense; $i++ ) {
    @sentense = @sentense[0..$i - 1, $i + 1..$#sentense], redo if ( $sentense[$i] =~ s/\b/$&/g < 10 )
  }
  
  # обрубаем каждое слово до $cut симсолов   
  s/(\b)([\da-z]+?)(\b)/$1.substr($2, 0, $cut).$3/gie for ( @sentense );


  # выводим результат 
  print $fout join "\n", @sentense;
  close ($fin, $fout);
PM MAIL   Вверх
amg
Дата 9.3.2009, 11:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 38
Всего: 50
Цитата(klem4 @  8.3.2009,  21:32 Найти цитируемый пост)
amg, ваш код дает не верный результат на файле
Добрался до компьютера, где смог протестировать... Мой код (с поправкой $N=2) на Вашем примере выдает 
12345 xxx 
1 2
Именно это я и ожидал. Ваш код на Вашем же примере:
12 xx x x x.
 1 2 3 4 5.
a b c d e
Вы считаете более правильным последний результат?

Из очевидного: налицо различие в подходе к интерпретации "предложение". У меня оно заканчивается точкой, после которой обязательно следует пробельный символ, у Вас -- просто точкой. Что более правильно -- вопрос. Предложения бывают и такими: "D.I.Mendeleev is a great russian chemist."
Аналогично -- с понятием "слово".
PM MAIL   Вверх
klem4
Дата 9.3.2009, 12:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: 2
Всего: 2
В общем ждем уточнений топикстартера, без них можно к гадалке идти.
PM MAIL   Вверх
mastercz
Дата 11.3.2009, 07:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: нет
Предложу ка и я свой вариант на вскидку...
Я себе позволил некоторое допущение от ТЗ..

Код

#!/usr/bin/perl

####################################                        
#        ReadLenStr            
# Разбивает текст на предложения по разделителю    
# Записывает в файл строки по количеств слов.                                                                 
####################################


    open IN,  '<', "file_in.txt"  or die;
    open OUT, '>', "file_out.txt" or die;

    my $Separator='.';
    my $WordNum=4;
    my $Sentence="";
    my $StrPos="";
    my $InputStr="";
    my @ArrayStr;
    my $i;

    while(<IN>)
    {
        $InputStr=$_;
        
        $InputStr=~s/\r+//;
        $InputStr=~s/\n+//;             
    
        while($InputStr ne "")
            {
            $StrPos=index($InputStr,$Separator);
            
            if( $StrPos == -1 )
                {
                $Sentence.=" ".$InputStr; 
                $InputStr="";
            }
            else
            {
                $Sentence.=" ".substr($InputStr,0,$StrPos);        

                $Sentence=~s/^\s+//;
                $Sentence=~s/\s+$//;                
    
                @ArrayStr=split(/\s+/,$Sentence); 
        
                $Sentence="";

                if($WordNum<@ArrayStr)
                {                
                    for($i=0;$i<=$WordNum;$i++)
                    {
                        $Sentence.=" ".shift(@ArrayStr);                
                    }
                    $Sentence=~s/^\s//;                     
                
                    print OUT $Sentence."\n";
                    $Sentence="";                                    
                }

                if(length($InputStr)>$StrPos+1)        
                {        
                    $InputStr=substr($InputStr,$StrPos+1);
                }
                else
                {
                    $InputStr="";
                }
            }
        }    
    }
    
    if($Sentence ne "")
    {

        $Sentence=~s/^\s+//;
        $Sentence=~s/\s+$//;                
    
        @ArrayStr=split(/\s+/,$Sentence); 
        
        $Sentence="";

        if($WordNum<@ArrayStr)
            {                
            for($i=0;$i<=$WordNum;$i++)
                {
                    $Sentence.=" ".shift(@ArrayStr);                
                }
                $Sentence=~s/^\s//;                     
                
            print OUT $Sentence."\n";
            $Sentence="";                                    
            }    
    }
    

close IN;
close OUT;    
PM MAIL   Вверх
viperson
Дата 20.3.2009, 18:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

Репутация: нет
Всего: -1
Уезжал я и не следил за топиком. Пробел после точки должен удаляться, чтобы перенос на новую строку происходил без этого пробела. В остальном требования не меняются.
PM   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl"
korob2001
sharq
  • В этом разделе обсуждаются общие вопросы по языку Perl
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Если ваш вопрос относится к CGI программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", можно скачать здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, korob2001, sharq.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Perl: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0485 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.