VPF::Задачка для напряжения мозга :-)

DooZ

Дата 20.4.2010, 17:05 (ссылка)

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

Загрузка ...

Бывалый

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

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

Здравствуйте,

код скрипта

Код


#!/usr/bin/perl -w

use strict;

my (@base1, %base1, @base2, %base2);

open(F, '1.txt');

    while (my $line = <F>)
    {
    chomp($line);
    next if (!$line);

    $base1{$line}{'total'} = 10;
    $base1{$line}{'rnd'} = int rand 9999999;
    }

close(F);

open(F, '2.txt');

    while (my $line = <F>)
    {
    chomp($line);
    next if (!$line);

    $base2{$line} = int rand 9999999;
    }

close(F);

open(OUT, ">out.txt");

    while (scalar(keys %base1))
    {
    my $text = '';
    my $max = 5;
    my $base2 = shift @base2;

        if (!$base2)
        {
            foreach my $base (sort { $base2{$a} <=> $base2{$b} } keys %base2)
            {
            $base2{$base} = int rand 9999999;
            push(@base2, $base);
            }

        $base2 = shift @base2;
        }

        if (!scalar(@base1))
        {
            foreach my $base (sort { $base1{$a}{'rnd'} <=> $base1{$b}{'rnd'} } keys %base1)
            {
            push(@base1, $base);
            }
        }

        while (my $base = shift @base1)
        {
            if ($base1{$base}{'total'} <= 0)
            {
            delete $base1{$base};
            next;
            }

        $text .= "$base ";

        $base1{$base}{'total'}--;
        $base1{$base}{'rnd'} = int rand 9999999;

        last if (!--$max);
        }

    print OUT "$base2|$text\n";
    }

файл 1.txt

Код

файл 2.txt

Код


a
b
c

теперь собственно задача smile

есть файл 1.txt и файл 2.txt

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

собственно скрипт отлично с этим справляется, когда данных не много

но проблема возникает, когда данных:
1.txt - 8.000.000 строк
2.txt - 100.000 строк

работает очень медленно и жрет кучу памяти

я пробовал разбить 1.txt на мелкие файлы, но скорость оставляет желать лучшего...
да и опять же нужна рандомность, т.е. что бы данные были каждый раз рандомные, в смысле смешивались рандомно

собственно прошу помощи smile

как быть?

Добавлено через 2 минуты и 21 секунду
тут собственно получается если из примера взять входные данные, то на файле в 8 миллионов строк и 100 тысяч строк соответсвенно, операций придется проделать:
(8.000.000 * 10) / 5 = 40.000.000, данный скрипт с ними не справляется...

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

gcc

Дата 20.4.2010, 17:22 (ссылка)

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

Загрузка ...

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

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

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

http://search.cpan.org/~jfreeman/File-Sort...e/SortedSeek.pm

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

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

DooZ

Дата 20.4.2010, 17:29 (ссылка)

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

Загрузка ...

Бывалый

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

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

2gcc сенькс, щас буду читать и разбираться

Добавлено через 3 минуты и 35 секунд
почитал, чет не понял как тот модуль подходит к моей задаче?

arto

Дата 20.4.2010, 17:38 (ссылка)

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

Загрузка ...

Эксперт

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

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

вы словами расскажите, что надо сделать

DooZ

Дата 20.4.2010, 17:42 (ссылка)

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

Загрузка ...

Бывалый

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

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

словами затрудняюсь, в принципе если запустить мой скрипт, все будет понятно

попробую словами описать:

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

в итоге должно получиться, что из файла 1.txt нужное кол-во строк смешается с каждой строкой из файла 2.txt опять же нужное кол-во раз

вообщем словами объяснить очень сложно, проще запустить скрипт и все станет понятно
там в выходном файле out.txt сразу все видно

arto

Дата 20.4.2010, 18:12 (ссылка)

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

Загрузка ...

Эксперт

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

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

perldoc -q "How do I select a random line from a file"

DooZ

Дата 20.4.2010, 18:13 (ссылка)

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

Загрузка ...

Бывалый

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

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

2arto Вы запускали скрипт, который я в начале выложил?

запустите, все станет сразу понятно
рандомные строки из файла это я просто написал, что бы как-то понять задачу, там все намного сложнее

dva300

Дата 20.4.2010, 18:48 (ссылка)

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

Загрузка ...

Бывалый

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

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

Цитата(DooZ @ 20.4.2010, 18:13)

при условии что я правильно понял...
рассмотрим частный случай -
1) N строк из файла №1 может участвовать в перестановке один раз
2) M строк из файла два может участвовать в перестановке один раз

для простоты возьмем N=5 M=1
зачем одну и туже комбинацию прогонять по несколько раз я не понимаю - разве что вывод будет в разные файлы....

в итоге задача сводится к тому каким образом уникально получить комбинацию из M+N строк на выходе (и главное быстро)
в сети бродят задачи под название "тосовка колоды карт"....

решение задачи

Код


@lines = массив M+N;
@lines_reverce = &gen(scalar(@lines));
$i=0;
foreach (@lines_reverce)
    {
    $mas_end[$i++] = $lines[$_]; 
    }

получаем @mas_end = уникально сформированный массив из M+N

Код


sub gen
    {
    my $lenght_of_src = shift;
    my (@mas_end);
    $lenght_of_src = $lenght_of_src - 1;    
    my @mas = ('0'.."$lenght_of_src");

    for (my $i=0;$i<$lenght_of_dst;$i++)
        {
        my $pp = int(rand(scalar(@mas)));
        $mas_end[$i] = $mas[$pp];
        splice(@mas,$pp,1);
        }
    return @mas_end;
    }

для примера - подобный алгоритм у меня работает на уникальном тусовании файла примерно твоих обьемов.
т.е. тебе нужно просто последовательно уменьшать область выбора твоих строк.
я как то пробовал что-то подобное делать с сортировкой так и 10тыс строк не смог осилить - успевал и поесть и поспать.

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

Участник движения Культура Вождения

arto

Дата 20.4.2010, 19:40 (ссылка)

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

Загрузка ...

Эксперт

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

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

вы просто не поняли решения, которое я предложил.

dva300

Дата 20.4.2010, 19:44 (ссылка)

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

Загрузка ...

Бывалый

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

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

Цитата(arto @ 20.4.2010, 19:40)

вы просто не поняли решения, которое я предложил.

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

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

Участник движения Культура Вождения

dva300

Дата 20.4.2010, 20:36 (ссылка)

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

Загрузка ...

Бывалый

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

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

to DooZ
см пример - может поможет -
формат вызова - src.pl file1 file2 N M
N - сколько строк взять из файла file1
M- сколько строк взять из файла file2

вывод будет в файл в этой же директории src_out.txt

проверял на
file1 - 1 мио
file2 -10K
N = 10K
M = 5K

2 сек

Код


use strict;

my $file_1 = shift || die " : $!\n";
my $file_2 = shift || die " : $!\n";
my $lines_1 = shift || die " : $!\n";
my $lines_2 = shift || die " : $!\n";

my (@lines_1,@lines_2,@lines_reverce,@lines_reverce_1,@lines_reverce_2,@mas_end,@mas_end_1,@mas_end_2,$i);

$i=0;
open (SRC,"$file_1") or die "error (1) : $!\n";
while(<SRC>)
    {
    $lines_1[$i++] = $_;
    }
close(SRC) or die "error (2) :$!\n";
$i=0;
open (SRC,"$file_2") or die "error (1) : $!\n";
while(<SRC>)
    {
    $lines_2[$i++] = $_;
    }
close(SRC) or die "error (2) :$!\n";

@lines_reverce_1 = &gen(scalar(@lines_1),$lines_1);
@lines_reverce_2 = &gen(scalar(@lines_2),$lines_2);
 
$i=0;
foreach (@lines_reverce_1)
    {
    $mas_end_1[$i++] = $lines_1[$_]; 
    }
$i=0;
foreach (@lines_reverce_2)
    {
    $mas_end_2[$i++] = $lines_2[$_]; 
    }
splice(@mas_end_1,scalar(@mas_end_1),scalar(@mas_end_2),@mas_end_2);
@lines_reverce = &gen(scalar(@mas_end_1),scalar(@mas_end_1));    
$i=0;
foreach (@lines_reverce)
    {
    $mas_end[$i++] = $mas_end_1[$_]; 
    }

open(DST,">src_out.txt") or die "Cann't open file : $!\n";
print DST @mas_end;
close(DST) or die "Cann't close file : $!\n";


#--------------------------------------------------------------------------------------------------------------    
# Функция gen генерить строку с уникальными ключами к массиву @lines
#--------------------------------------------------------------------------------------------------------------
sub gen
    {
    my $lenght_of_src = shift;
    my $lenght_of_dst = shift;
    my (@mas_end,@mas_tmp);
    if ($lenght_of_dst > $lenght_of_src)
        {
        $lenght_of_dst = $lenght_of_src;
        }
    $lenght_of_src = $lenght_of_src - 1;    
    my @mas = ('0'.."$lenght_of_src");
    
    for (my $i=0;$i<$lenght_of_dst;$i++)
        {
        my $pp = int(rand(scalar(@mas)));
        $mas_end[$i] = $mas[$pp];
        splice(@mas,$pp,1);
        }
    return @mas_end;
    }

Это сообщение отредактировал(а) dva300 - 20.4.2010, 20:52

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

Участник движения Культура Вождения

gcc

Дата 20.4.2010, 21:09 (ссылка)

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

Загрузка ...

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

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

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

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

примерно так:

Код



#!/usr/bin/perl
  if (!$ARGV[0])   {
    print 'no key';
    exit;    }
  open my $fi, '666.txt';
  sub filess {
    my $ss = int((@_[0] + @_[1]) / 2);
      return 0 if @_[0] == $ss or @_[1] == $ss;
    seek $fi, $ss, 0;
    <$fi>;
    my $line = <$fi>;
    my @h = split( /\t/, $line, 2 );
   if ($h[0] eq $ARGV[0]) {
    print $h[1];
    exit;
   }
    return filess(@_[0], $ss) if(($ARGV[0] cmp $h[0]) == -1);
    return filess($ss, @_[1]) if(($ARGV[0] cmp $h[0]) == 1);
  }
  filess(0, -s $fi);

Код


#!/usr/bin/perl
use File::SortedSeek ':all';
@{$hex->[0]} = 'D';
  open BIG, 'file.txt' or die $!;
$tell = alphabetic( *BIG, @{$hex->[0]} );
$line = <BIG>;
@{$hex->[1]} = split( /\t/, $line, 2 );
print @{$hex->[1]};

Код


#!/usr/bin/perl -w
# размер блока для чтения, чтобы не читать посимвольно
my $read_block_size = 256;
# функция для сдвига к границе записи
# принимает хэндл и направление движения
# направление = 0 - двигаемся вперед к началу следующей записи - вообще-то не используется smile.gif
# = 1 - назад - к началу текущей записи
sub rec_shift {
my( $file, $dir ) = @_;
my( $buf, $ofs );
# крутимся пока не дойдем
while( 1 ) {
# получаем текущее смещение
$ofs = tell( $file );
# в зависимости от направления
if( !$dir ) {
# направление вперед, аналогично считыванию записи,
# к тому же не используется в программе, коментировать лень
read( $file, $buf, $read_block_size );
my $o = index( $buf, "\x0a" );
if( $o >= 0 ) {
seek( $file, $ofs + $o + 1, 0 );
return;
} elsif( eof( $file ) ) {
return;
}
} else {
# к началу записи - назад
# смотрим на текущее смещение и сравниваем с размером блока который хотим считать
# ессно, выбираем меньшее
my $r = $ofs > $read_block_size ? $read_block_size : $ofs;
# смещаемся назад на размер блока
seek( $file, -$r, 1 );
# читаем блок
read( $file, $buf, $r );
# снова возвращаемся на начало блока, т.к. чтение сдвинуло на прежнюю точку
seek( $file, -$r, 1 );
# ищем разделитель (ессно, с конца блока, потому что идем назад)
my $o = rindex( $buf, "\x0a" );
if( $o >= 0 ) {
# нашли! смешаемся на начало записи и все smile.gif
seek( $file, $o + 1, 1 );
return;
} elsif( $r == $ofs ) {
# не нашли, но размер блока для чтения равен ранее смещению до конца текущего блока
# следовательно мы находимся в начале файла (а значит и какой-то записи)
# можно было не сдвигаться, но так, на всякий пожарный smile.gif
seek( $file, 0, 0 );
return;
}
}
}
}
# считывает запись от текущего положения и смещает к началу следующей
# АХТУНГ! функция преполагает, что мы находимся в начале записи
# принимает хэндл файла
sub rec_read {
my( $file ) = @_;
# 'это и будет наша запись
my $ln = '';
my $buf;
while( 1 ) {
# получаем текущее смещение
my $ofs = tell( $file );
# считываем блок
read( $file, $buf, $read_block_size );
# ищем в нем перевод стоки - разделитель записей
my $o = index( $buf, "\x0a" );
# если нашли, то
if( $o >= 0 ) {
# смещаемся к началу следующей записи
seek( $file, $ofs + $o + 1, 0 );
# добавляем кусок буфера от начала до конца (не включая разделитель)
$ln .= substr( $buf, 0, $o );
# разделяем строку по табуляции (разделитель ключа и значения) и возвращаем такой вот массивчик
return split( /\t/, $ln );
}
# если не нашли разделитель --> добавляем весь буфер и читаем следующую порцию, повторяя все снова, пока не найдем
$ln .= $buf;
}
}
# основная функция бинарного поиска
# принимает хэндл файла, ключ, начало и конец данных для поиска
sub filebinsearch {
my( $file, $fkey, $beg, $end ) = @_;
# если конец == началу, то данных уже нет, значит ключ не найден
return undef if $beg == $end;
# вычисляем середину наших данных
my $oc = int( ( $beg + $end ) / 2 ); # ( $beg + $end ) >> 1 -- 32bit :-(
# смещаемся к середине
seek( $file, $oc, 0 );
# сдвигаемся к НАЧАЛУ записи (могли попасть куда угодно) на которой стоим
rec_shift( $file, 1 );
# запоминаем смещение начала файла
$oc = tell( $file );
# считываем ценральную запись
my( $key, $value ) = rec_read( $file );
# если попали туда, куда надо - возвращаем значение
return $value if $key eq $fkey;
# сравниваем эталонный ключ с найденным
if( $key lt $fkey ) {
# найденный ключ меньше эталонного, значит первую половину
# можно отбросить и повторить поиск только для второй части
# которая начинается с конца ранее найденной и заканичвается там,
# где и был конец исходных данных
filebinsearch( $file, $fkey, tell( $file ), $end );
} else {
# найденный ключ больше искомого --> опускаем вторую половину
# ищем только в первой, кот. начинается с начала исходных
# данных и заканчивается в начале ранее найденной записи
filebinsearch( $file, $fkey, $beg, $oc );
}
}
# собственно функция задания, которую и надо вызывать
# принимает имя файла и ключ который ищем
sub findinfile {
my( $filename, $key ) = @_;
my $value = undef;
my $filesize = 0;
# а есть ли вообще такой файл?
return undef if !-f $filename;
# а можем ли мы его прочесть?
return undef if !-r $filename;
# а в нем хоть что-то есть? попутно сохраняем размер файла
return undef if !($filesize = -s $filename);
# открываем и проверяем получилось ли это
return undef if !open( $file, '<', $filename );
# вызываем рекурсивную функцию - основа бинарного поиска
return filebinsearch( $file, $key, 0, $filesize );
}
print findinfile( $ARGV[0], $ARGV[1] ) . "\n";

http://ru.wikipedia.org/wiki/%D0%94%D0%B2%...%B8%D1%81%D0%BA
из wikipedia для бинарного:

Код


 i := 1;  { индекс первого элемента массива }
  j := n;  { индекс последнего элемента массива (0, если массив пуст) }
 
  while i <= j do begin
    { ищем элемент на интервале индексов от i до j, включительно }
    k := i + (j - i) div 2;  { k = элемент посередине интервала }
    if x > A[k] then
      i := k + 1
    else if x < A[k] then
      j := k - 1
    else
      break;  { искомый элемент найден }
  end;
 
  { алгоритм выше останавливается в двух случаях:
    1) либо i > j и элемент не был найден,
    2) либо i <= k <= j и A[k] = искомый элемент. }

Это сообщение отредактировал(а) gcc - 20.4.2010, 21:15

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

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

DooZ

Дата 21.4.2010, 18:57 (ссылка)

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

Загрузка ...

Бывалый

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

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

2gcc к моей задаче файлы не подходят
2dva300 Ваш код на моем примере с моими двумя файлами в котором 8 миллионов и 10к строк, вообще зависает =)

видимо не поняли что надо, ну лана, буду своими силами решать задачу

хотя если запустить мой пример - в начале, все станет предельно ясно из выходного файла

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