Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Perl: Общие вопросы > нужна помощь


Автор: DooZ 14.4.2008, 22:54
задача следующая:

есть файл со словами (очень большой, например 500 мегабайт, или 10.000.000 слов, как пример)
мама смотрит в окно
моя книга очень интересная
книга и авто не совместимы

все слова в столбик

есть второй файл, со словами по которым делать выборку, пример:
авто
окно
книга

суть скрипта следующая:
поочередно берем слова из второго файла и вытягиваем слова из первого
т.е.

Код

foreach my $request (keys %request)
{
if ($keyword =~ /(?:^|\s+)$request(?:\s+|$)/i)
{
open(F, ">>$request");
print F "$keyword\n";
close(F);
}


как видите, в первом файле могут быть строки вроде:
книга и авто не совместимы

в свою очередь во втором файле мы видим что нам нужны все строки где есть слово: "авто" и "книга"
т.е. мы должды записать строку: "книга и авто не совместимы" в файл: "авто"
И (!)
эту же строку записать в файл: "книга"

т.е. вариант с объединением всех запросов для нахождения в один регекс не катит т.к. будет найдено только одно совпадение

посоветовали сделать сначала выборку путем комманды: "cat $file|grep -P '(?:^|\s+)(?:окно|авто|книга)(?:\s+|$)' >tmp/complete"
и потом уже разбирать файл complete построчно
НО очень долго получается разбирать его

т.е. cat + grep работает очень быстро
а вот выборка по нужным запросом долго (файл в миллион строк, разбирается около часа)

т.е. получается в данном случае нам надо три запроса:
окно
книга
авто
т.е. если cat + grep насобирал миллион записей, то при выборке будет обработано 3.000.000 записей

у меня этих запросов сотни, соответсвенно кол-во выборок увеличивается не по детски =)

как быть? кто что подскажет?

можно в аську: 9603308 (можно за денежку, если действительно быстро будет работать, о цене договоримся)

заранее благодарю

Автор: arto 14.4.2008, 23:08
grep "\\b$word\\b" ?
+ распарралелить по возможности

Автор: DooZ 14.4.2008, 23:12
поточнее можно?
мне надо каждую найденую строку У КАЖДОГО запроса записать в свой файл
т.е.
если в файле номер 1 есть строка:
ааа ббб ввв ггг ддд

а в файле 2 в котором нужные мне запросы есть два запроса:
ббб
ддд

надо записать в два файла эту строку
в файл: ббб
и в файл: ддд

Автор: arto 14.4.2008, 23:21
1. поделить второй список по 20 слов, например.
2. запускать по 20 процессов grep с выводом в нужный файл
3. удалить пустые файлы.
4. простой греп быстрее, чем perl regexp

Автор: DooZ 14.4.2008, 23:21
разделение на процессы не дает скорости, процессор один и толку делить нет, проверено

Добавлено через 2 минуты и 30 секунд
проблемма не у grep, а в том что много запросов нужных мне, и приходится перебирать массив (хеш) и работать с каждым запросом на каждой строке

если запросов 100, то на одну строку идет 100 проверок и т.д. в этом и проблема!
почему приходится перебирать цикл? потому что мне надо на каждый запрос проверить строку, и если в этой строке есть запрос надо записать его в файл

Добавлено через 11 минут и 12 секунд
вот код тот что щас работает:

Код

#!/usr/bin/perl -w

use strict;

my %request;
my $request = "";

open(F, "request");

    while (my $request=<F>)
    {
    chomp($request);
    next if (!$request || $request eq "");
    $request{$request}++;
    }

close(F);

    foreach my $r (keys %request)
    {
    $request .= "$r|";
    }

$request =~ s/\|$//;
####################
my $grep = '(?:^|\s+)(?:'.$request.')(?:\s+|$)';
system("cat $file|grep -P '$grep' >complete");

open(F, "complete");

    while (my $keyword=<F>)
    {
    chomp($keyword);
    next if (!$keyword || $keyword eq "");

#вот место то что тормозит
#оно и понятно, запросов порядка 100 штук, соответственно на каждую строку 100 проверок, как быть???
#а смысл проверок в том что бы взять строку, для каждого нужного мне запроса, а не одну на первый попавшийся

        foreach my $request (keys %request)
        {
            if ($keyword =~ /(?:^|\s+)$request(?:\s+|$)/i)
            {
            open(WRITE, ">>out/$request");
            print WRITE "$keyword\n";
            close(WRITE);
            }
        }
    }

close(F);

Автор: arto 14.4.2008, 23:50
тогда вам надо подготовить списки под задачу заранее.

Автор: DooZ 14.4.2008, 23:55
т.е. подготовить?

они и так подготовлены
в файле1, список строк на проверку
в файле2, список слов которые мне нужно выдирать из файла1, что тут не подготовлено?

или я чего-то не понимаю, или Вы меня smile

Автор: arto 15.4.2008, 00:01
не понимаете, да.

например -- адреса всех слов в первом файле, с длиной.
тогда сможете сократить перебор по длине.
еще можете проиндексировать по первой букве.

делать это надо не сейчас, а когда собирается первый файл.

Автор: sir_nuf_nuf 15.4.2008, 00:01
так...если хотим простое решение, то на мой взгляд их 2
в обоих случаях - 2 цикла , один в другом.

в первом проходим по всем строкам,  для каждой строки ищем ключи:

Код

open STRS, "<first" or die "no first";
open KEYS, "<second" or die "no second";
my @keys = <KEYS>;
chomp @keys;
my %handles = map {open my $fh, ">$_"; $_ => $fh } @keys;
my %regex = map {$_ => qr/$_/} @keys;
foreach my $str (<STRS>) {
    foreach my $key (keys %regex) {
        if ($str =~ $regex{$key}) {
            my $fh = $handles{$key};
            print $fh $str;
        }
    }
}

close STRS;
close KEYS;



или второй вариант - для каждого ключа полностью просматриваем файл с данными
Код

open STRS, "<first" or die "no first";
open KEYS, "<second" or die "no second";
my @keys = <KEYS>;
chomp @keys;
my %handles = map {open my $fh, ">$_"; $_ => $fh } @keys;
my %regex = map {$_ => qr/$_/} @keys;
foreach my $key (keys %regex) {
    seek(STRS, 0,0);
    foreach my $str (<STRS>) {
        if ($str =~ $regex{$key}) {
            my $fh = $handles{$key};
            print $fh $str;
        }
    }
}

close STRS;
close KEYS;


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

есть еще вариант - засунуть перебор шаблонов в регулярку:
Код

open STRS, "<first" or die "no first";
open KEYS, "<second" or die "no second";

my @keys = <KEYS>;
chomp @keys;
my %handles = map {open my $fh, ">$_"; $_ => $fh } @keys;
my $regex = "(" . join("|", @keys) . ")";
my $compiled = qr/$regex/;
foreach my $str (<STRS>) {
    if (my @matches = $str =~ /$compiled/g ) {
        foreach my $file (@matches) {
            my $h = $handles{$file};
            print $h $str;
        }
    }
}

close STRS;
close KEYS;

здесь перебор ключей осуществляется движком regex. Не думаю, что он делает оптимизацию для поиска 
по нескольким ключам, скорее всего просматривает строку на наличие каждго ключа последовательно.


Если вам нужен _быстрый_ поиск по нескольким ключам - заведите новый топик и изучите алгоритмы =)

Автор: DooZ 15.4.2008, 01:27
2sir_nuf_nuf
первый вариант теряет всю скорость, если регекс делать таким:
(?:^|\s+)$_(?:\s+|$)
что ознатает что нужный запрос может быть
в начале, после него могут быть пробелы или конец текста
или в конце
или перед и после пробелы и т.д.

а так и надо искать, ибо твой вариант где просто $_ будет искать например:
запрос: машина

-> у меня есть машина (годится)
-> у друга есть машина (годится)
-> естьмашина (не годится, а твой вариант возьмет его!)

есть еще мысли как ускорить?

Автор: DooZ 15.4.2008, 01:45
третий вариант очень быстрый, но в нем минус, если он встречает первое нужное слово в строке, то если даже в этой строке есть второй нужное слово, он его уже не запишет!

Автор: DooZ 15.4.2008, 02:05
вроде заработал третий пример вот так:

    foreach my $str (<STRS>)
    {
        if ($str =~ /$compiled/igs)
        {
            foreach my $file (split(/\s+/, $str))
            {
            next unless (exists $handles{$file});
            my $h = $handles{$file};
            print $h $str;
            }
        }
    }

скорость на 160 запросах, и 100.000 строк файл первый, 1.5 секунды
первый пример справлялся за 60 секунд

Автор: sir_nuf_nuf 15.4.2008, 08:51
насчет третьего варианта - ты не прав. \
там специально стоит модификатор g и поиск в списковом контексте.
так что третий вариант не будет останавливаться после первого совпадения.

(?:^|\s+)$_(?:\s+|$) -- на счет этого я не подумал.. действительно нужно искать слова целиком

только шаблон этот записывается так:
\b$_\b

Автор: DooZ 15.4.2008, 11:12
а ты проверь третий пример, без моего добавления. он именно находит первое совпадение и все...

Автор: DooZ 15.4.2008, 11:53
щас проверил четвертый вариант

Код

open(F, "request");

    foreach my $request (<F>)
    {
    chomp($request);
    next if (!$request || $request eq "");
    open my $fh, ">out/$request";
    $request{$request} = $fh;
    }

close(F);

open STRS, "base" or die "no first";

    foreach my $str (<STRS>)
    {
        foreach my $file (split(/\s+/, $str))
        {
        next unless (exists $request{$file});
        my $h = $request{$file};
        print $h $str;
        }
    }

close STRS;



работает на 100к базе при 158 запросах за 0.6 секунды

Автор: DooZ 15.4.2008, 12:09
косяк в 4 варианте, нельзя использовать запросы более одного слова, иначе не найдет

Автор: amg 15.4.2008, 12:53
DooZ, зачем Вы все время используете конструкцию foreach my $str (<STRS>) ...? Ведь при этом весь файл в виде массива будет помещен в оперативную память. А если ее не хватит? Сами же говорите -- файлы большие. Используйте лучше while (my $str = <STRS>) .... Файл будет обрабатываться построчно, и, может быть, даже быстрее.

Автор: sir_nuf_nuf 15.4.2008, 12:55
странно, у меня 3ий вариант работает нормально

файлы:

first:
Код

mama mila ramu
riki tiki tavi
tavi mama


second:
Код

mama
tavi



tavi:
Код

riki tiki tavi
tavi mama


mama:
Код

mama mila ramu
tavi mama

Автор: yura_nev 15.4.2008, 13:51
Код

perl -ne 'BEGIN{open$h,"keys.txt";chomp&&open($k{" $_ "},">",$_)for<$h>;close$h;@w=keys%k;}$s=$_;s/\s+/ /;$_=" $_ ";for$w(@w){if(index($_,$w)>=0){$h=$k{$w};print $h $s}}' big_text_file.txt

keys.txt - файл слов, одна строка - одно слово
big_text_file.txt - файл для разбора

Цитата
здесь перебор ключей осуществляется движком regex. Не думаю, что он делает оптимизацию для поиска 
по нескольким ключам, скорее всего просматривает строку на наличие каждго ключа последовательно.
perlre
perldoc -f study

Автор: DooZ 15.4.2008, 13:59
2amg - foreach не мой вариант, а вариант sir_nuf_nuf
мой пример (исходник) без этих циклов

Автор: amg 15.4.2008, 14:26
Цитата(DooZ @  15.4.2008,  13:59 Найти цитируемый пост)
2amg - foreach не мой вариант
Да, действительно, прошу прощения. 

yura_nev, Вы дискредитируете идею перловских однострочников smile 

Кстати, DooZ, мысль yura_nev использовать index для определения наличия слова в строке может быть плодотворной. Эта функция гораздо быстрее, чем регулярные выражения или split.

Автор: yura_nev 15.4.2008, 14:39
amg, каким образом?
вообще говоря, мне просто лень было открывать редактор

Автор: sir_nuf_nuf 15.4.2008, 16:59
Цитата(amg @ 15.4.2008,  14:26)
Цитата(DooZ @  15.4.2008,  13:59 Найти цитируемый пост)
2amg - foreach не мой вариант
Да, действительно, прошу прощения. 

yura_nev, Вы дискредитируете идею перловских однострочников smile 

Кстати, DooZ, мысль yura_nev использовать index для определения наличия слова в строке может быть плодотворной. Эта функция гораздо быстрее, чем регулярные выражения или split.

это мой вариант..
действительно, чтение в списковом громадных файлов в списковом контексте - не лучшая идея.
как то не подумал =(

идея строить индексы с помощью study  - великолепно =)

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

Автор: GoDleSS 15.4.2008, 18:19
Если работать индексом, то врят ли получится оптимизировать сильно, так что вот такой набросок:
Код

#!perl

my $dict = 'dict2.txt';
my $dbf = 'db.txt';
my $output = 'output';

parse_long($dbf, $dict, $output);

sub parse_long {
    my ($dbf, $dict_link, $output) = (
        shift || return,
        get_dict(shift) || return,
        shift || '.'
    );

    my (%struct, $keyword);

    open(DBF, $dbf);
        while(<DBF>) {
            next if ($_ eq '');#удалить, если файл точно без пустых строк
            foreach $keyword (@$dict_link) {
                if ( index($_, $keyword)+1 ) {
                    push(@{ $struct{$keyword} }, $_);
                }
            }
        }
    close(DBF);

    foreach (keys %struct) {
        open(OF, ">$output/$_");
            print OF @{ $struct{$_} };
        close(OF);
    }
}

sub get_dict {
    my $file=shift;
    my @dict;
    open(DF, $file);
        while(<DF>) {
            chomp;
            push(@dict, $_);
        }
    close(DF);
    return \@dict;
}



Куча минусов, в том числе и регистрозависимость поиска.
Ну уж если важна скорость )

Автор: sir_nuf_nuf 15.4.2008, 21:14
функция get_dict пишется проще

sub get_dict 
{
    open my $file "<<$_[0]" or die "for ever";
    my @strs = <$file>;
    chomp @strs;
    return \@strs;
}

и вы не поняли про индекс. имелась ввиду не функция index.
говорили про то, что study $str
создает скрытую структуру данных для строки $str
при чем поиск для такой строки будет происходить намного быстрее.

примерно так:
$str = "mama mila lamu"

будет создан индекс букв:

a - 1,3,8,11
m - 0,2,5,12
i - 6
l - 7,10
u - 13

теперь когда мы будем искать подстроку "mu"

мы не будем просматривать строку с самого начала,
мы по индексу найдем , что "u" встречается в 13 позиции,
а потом проверим, что в 12 позиции есть буква "m"

вот примерно так работает study + regex

perldoc -f study =)



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

Автор: GoDleSS 15.4.2008, 23:22
Цитата

sub get_dict 
{
    open my $file "<<$_[0]" or die "for ever";
    my @strs = <$file>;
    chomp @strs;
    return \@strs;
}

Не красиво оставлять открытыми потоки ввода/вывода ;)

Но 
Код

chomp @strs;

для меня новость, спасибо )

Цитата

говорили про то, что study $str
создает скрытую структуру данных для строки $str
при чем поиск для такой строки будет происходить намного быстрее.

примерно так:
$str = "mama mila lamu"

будет создан индекс букв:

a - 1,3,8,11
m - 0,2,5,12
i - 6
l - 7,10
u - 13

теперь когда мы будем искать подстроку "mu"

мы не будем просматривать строку с самого начала,
мы по индексу найдем , что "u" встречается в 13 позиции,
а потом проверим, что в 12 позиции есть буква "m"

очень сомневаюсь, что даже такая констукция, при малой длине строки и большом кол-ве этих строк, будет работать заметно быстрее, чем index/rindex.
Хотя... ...практика покажет smile

Цитата

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

Любопытно: 
Поделить на потоки? Либо сложный алгоритм, либо будет неэффективно.
В другом случае все равно все сведется к перебору, думаю понятно почему.

Может я что-то упускаю?

Автор: sir_nuf_nuf 16.4.2008, 00:45
Цитата

Не красиво оставлять открытыми потоки ввода/вывода ;)

да не красиво =) по этому я и написал эту функцию так.
поверьте (проверьте) в этом случае хендлер закрывается автоматически при выходе из блока.
в этом фишка использования лексических переменных =)
здесь переменная my $file ссылка на объект IO::File
при выходе из блока мы потеряем ссылку на объект, perl вызовет его DESTRUCTOR и поток будет закрыт =)

я представляю себе такой алгоритм: 

из слов - ключей строим дерево начиная с первой буквы.
например для ключей 

Код

ааа
ааb
abc
b


дерево будет выглядеть так:
Код

          root
           /  \
         a     b
        /  \
      a     b
     /  \     \
   a     b    c


далее отмечаем позицию в строке (в которой ищем), выбираем последовательно буквы из строки начиная с этой позиции.
Для каждой выбранной буквы спускаем вниз по дереву ключей.

Если мы пришли в лист дерева то мы нашли ключ в строке, например root -> a -> b -> c соответсвует найденному ключу abc.
Запоминаем, что мы нашли определенный ключ, передвигаем позицию вперед на длину ключа.

В случае если мы не можем спускаться дальше, например нет пути root -> a -> b -> x, то мы увеличиваем позицию на 1 символ.

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


Возможно, что оптимизатор регулярных выражений и догадывается делать поиск таким образом для шаблонов вида 
ааа|ааb|abc|b

как видите - не совсем перебор. мы ищем все ключи сразу =)
такой алгоритм не удобно писать на perl - в нем поддержки посимвольной обработки строк ( о не говорите мне про split(//,"..."));

Автор: GoDleSS 16.4.2008, 09:52
Цитата

такой алгоритм не удобно писать на perl - в нем поддержки посимвольной обработки строк ( о не говорите мне про split(//,"..."));

Согласен, что неэффективно решать данную проблему на перл. Если уж зашла речь о "ручном" разборе потока, лучше и решать более быстрыми, "классическими" инструментами, как то С.

Однако, используя perl также можно прийти к посимвольному чтению, достаточно пользоваться getc, [sys]read.
Сравнивать на эквивалентность односимвольных строк с помощью eq. В менее шустром варианте, опять же, с помощью index.
Для perl сие извращение, но возможность есть smile

Цитата

Возможно, что оптимизатор регулярных выражений и догадывается делать поиск таким образом для шаблонов вида 
ааа|ааb|abc|b

Сомневаюсь.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)