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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Уплотнение массива, замена нескольких пустых элементов одним 
:(
    Опции темы
arto
Дата 25.3.2007, 14:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 38
Всего: 40
map сейчас оптимизирован, и он не создает массива, если его не просят.
splice тем более.
PM MAIL ICQ   Вверх
Nab
Дата 25.3.2007, 15:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 26
Всего: 37
Цитата(arto @  25.3.2007,  14:24 Найти цитируемый пост)
map сейчас оптимизирован, и он не создает массива, если его не просят.splice тем более.

Возможно, а при вызове slice из map? я к примеру не уверен, скорее даже наоборот....


--------------------
 Чтобы правильно задать вопрос нужно знать больше половины ответа...
Perl Community 
FREESCO in Ukraine 
PM MAIL   Вверх
arto
Дата 25.3.2007, 16:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 38
Всего: 40
splice манипулитует оригинальным массивом.
грубо говоря проверяем элемент массива по указателю.
PM MAIL ICQ   Вверх
tishaishii
Дата 25.3.2007, 20:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Создатель
***


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

Репутация: 4
Всего: 8
Это вы про какую версию говорите?
PM MAIL ICQ Skype   Вверх
amg
  Дата 26.3.2007, 09:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 38
Всего: 50
Ну вот, потестировал. Тестируемый код приводить не буду, чтобы не занимать места. (arto-ref - это код arto с передачей массива по ссылке и модификацией его "по месту"). В колонке "Память" со знаком минус - это кол-во памяти, потребляеемой скриптом на создание массива. 
Код

Плотный массив        Время Память
----------------------------------
me1                   1.826 202-58
Nab-map               2.528 190-58
Nab-grep              2.979 190-58
tishaishii            2.551  64-58
arto                  2.213 198-58
arto-ref              0.703  89-58

Разреженный массив    Время Память
----------------------------------
me1                   0.162  24-14
Nab-map               0.286  24-14
Nab-grep              0.206  23-14
tishaishii            0.961  18-14
arto                  8.430  27-14
arto-ref              8.490  26-14

Nab-grep - это перл (в обоих смыслах). В коде tishaishii придется хорошо поразбираться, есть ради чего - дополнительная память почти не используется. Код arto удивительно быстро работает на "плотных" массивах - тоже надо поразбираться.

Господа! Всем большое спасибо.
PM MAIL   Вверх
Nab
Дата 26.3.2007, 12:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 26
Всего: 37
Ой, действительно интересные результаты smile
А почему мой первый вариант не включили, по моему он также будет наименее прожорлив, да и не вызывает slice для каждого елемента, то есть может дать выиграш на разреженном массиве...
Код

sub compress_array {
    my ($i, $space) = (0,0);
    # пока не достигли конца массива
    while ($i < @_) {
        # если елемент не пустой
        if ($_[$i++]) {
         # если предыдущие были пустыми елементами, то мы их удаляем
            if ($space--) {
                # откатываем индекс
                $i -= $space;
                # удаляем пустые елементы
                splice @_, $i - 1, $space;
            }
            # обнуляем счетчик пустых елементов
            $space = 0
        } else {
            # здесь мы будем если у нас пустой елемент,
            # мы его пропускаем, но увеличиваем счетчик...
            # чтоб обработать впоследствии
         $space++;
        }
    }
    # а здесь мы удаляем если в конце массива у нас пустые есть, мы то уже из цикла вышли по окончании индекса
    splice @_, $i - $space, $space if $space;
    # по необходимости удаляем первый
    splice @_, 0, 1 unless $_[0];
    return @_
}

Я его немного переделал, вполне удовлетворяет условиям задачи...

Добавлено через 13 минут и 48 секунд
А вот все мои варианты с передачей по ссылке, надеюсь будут менее прожорливы :(
Код

sub compress_array_grep {
    my $array = shift;
    my $s;
    @$array = grep {($_&&!($s=0))||!$s++} @$array;
    $array->[0]||shift(@$array);
    $array->[$#$array]||pop(@$array);
}

sub compress_array_map {
    my $array = shift;
    my $s;
    @$array = map {$_?($s=0 or$_):$s++?():$_} @$array;
    $array->[0]||shift(@$array);
    $array->[$#$array]||pop(@$array);
}


sub compress_array {
    my $array = shift;
    my ($i, $space) = (0,0);
    while ($i < @$array) {
        if ($array->[$i++]) {
            if ($space--) {
                $i -= $space;
                splice @$array, $i - 1, $space;
            }
            $space = 0
        } else {
         $space++;
        }
    }
    splice @$array, $i - $space, $space if $space;
    splice @$array, 0, 1 unless $array->[0];
}


Это сообщение отредактировал(а) Nab - 26.3.2007, 12:30


--------------------
 Чтобы правильно задать вопрос нужно знать больше половины ответа...
Perl Community 
FREESCO in Ukraine 
PM MAIL   Вверх
Nab
Дата 26.3.2007, 12:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


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

Репутация: 26
Всего: 37
Кстати amg, свой вариант опубликуй...


--------------------
 Чтобы правильно задать вопрос нужно знать больше половины ответа...
Perl Community 
FREESCO in Ukraine 
PM MAIL   Вверх
amg
Дата 26.3.2007, 16:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 38
Всего: 50
Цитата(Nab @  26.3.2007,  12:44 Найти цитируемый пост)
Кстати amg, свой вариант опубликуй...

Код

sub me1 {
  my $s = join ':', @_;
  $s =~ s/:0(:0)+/:0/g;
  return split ':', $s;
}
Я там где-то раньше говорил, что этот код медленно работает на реальных массивах, но это не так. Работает быстро, но память жрет...

Добавлено через 5 минут и 35 секунд
Цитата(Nab @  26.3.2007,  12:27 Найти цитируемый пост)
А почему мой первый вариант не включили
Да что-то он у меня сразу не пошел, а думать, в чем дело, было, как всегда, лень. Nab, завтра обязательно проверю твои новые варианты.


Это сообщение отредактировал(а) amg - 26.3.2007, 16:10
PM MAIL   Вверх
tishaishii
Дата 26.3.2007, 19:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Создатель
***


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

Репутация: 4
Всего: 8
Ну большие массивы много и памяти будут кушать.
Значит, надо этот массив хранить на диске и обрабатывать поэлементно.
Код
use IO::Handle;

sub separator {
    my($result, $len, @letters)=(undef, shift, 'a'..'z', 'A'..'Z', '0'..'9');
    $result.=$letters[@letters*rand] while $len--;
    +'='.$result.'='
}

my$seplen=0x10;
my$tin=($ENV{TEMP}||$ENV{TMP})."\\".time;
my$tout=$tin.'.out';

my@arr=(<<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.');
lkdsklfsd
sdfl;dsl;f
dsflds'fdsfds\
.
sdfdsf        sdfdsf
.
.
sadsad
sadsad
.
.
sadsad

.
sdflslf
.
sdfsdl;fl;sdf
dsf;ds
.
,    
.
0
.

my$separator=&separator($seplen);

#пиши массив в файлик
open my$fh, '>'.$tin;binmode $fh;
$fh->print(shift(@arr), $separator) while @arr;
close $fh;

$/=$separator;
$seplen+=2;

#потом этот файлик обрабатывай
open my$out, '>'.$tout;binmode $out;
open my$in, '<'.$tin;binmode $in;
while(<$in>) {
    substr $_, -$seplen, $seplen, undef;
    $out->print('['.$_.']') if length && !/^[\t\r\n0 ]+$/o;
}
close $in;
close $out;

print $tin, "\n", $tout, "\n";


Добавлено через 2 минуты и 43 секунды
Ну большие массивы много и памяти будут кушать.
Значит, надо этот массив хранить на диске и обрабатывать поэлементно.
Код
use IO::Handle;

sub separator {
    my($result, $len, @letters)=(undef, shift, 'a'..'z', 'A'..'Z', '0'..'9');
    $result.=$letters[@letters*rand] while $len--;
    +'='.$result.'='
}

my$seplen=0x10;
my$tin=($ENV{TEMP}||$ENV{TMP})."\\".time;
my$tout=$tin.'.out';

my@arr=(<<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.');
lkdsklfsd
sdfl;dsl;f
dsflds'fdsfds\
.
sdfdsf        sdfdsf
.
.
sadsad
sadsad
.
.
sadsad

.
sdflslf
.
sdfsdl;fl;sdf
dsf;ds
.
,    
.
0
.

my$separator=&separator($seplen);

#пиши массив в файлик
open my$fh, '>'.$tin;binmode $fh;
$fh->print(shift(@arr), $separator) while @arr;
close $fh;

$/=$separator;
$seplen+=2;

#потом этот файлик обрабатывай
open my$out, '>'.$tout;binmode $out;
open my$in, '<'.$tin;binmode $in;
while(<$in>) {
    substr $_, -$seplen, $seplen, undef;
    $out->print('['.$_.']') if length && !/^[\t\r\n0 ]+$/o;
}
close $in;
close $out;

print $tin, "\n", $tout, "\n";


Добавлено через 2 минуты и 54 секунды
Ну большие массивы много и памяти будут кушать.
Значит, надо этот массив хранить на диске и обрабатывать поэлементно.
Код
use IO::Handle;

sub separator {
    my($result, $len, @letters)=(undef, shift, 'a'..'z', 'A'..'Z', '0'..'9');
    $result.=$letters[@letters*rand] while $len--;
    +'='.$result.'='
}

my$seplen=0x10;
my$tin=($ENV{TEMP}||$ENV{TMP})."\\".time;
my$tout=$tin.'.out';

my@arr=(<<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.', <<'.');
lkdsklfsd
sdfl;dsl;f
dsflds'fdsfds\
.
sdfdsf        sdfdsf
.
.
sadsad
sadsad
.
.
sadsad

.
sdflslf
.
sdfsdl;fl;sdf
dsf;ds
.
,    
.
0
.

my$separator=&separator($seplen);

#пиши массив в файлик
open my$fh, '>'.$tin;binmode $fh;
$fh->print(shift(@arr), $separator) while @arr;
close $fh;

$/=$separator;
$seplen+=2;

#потом этот файлик обрабатывай
open my$out, '>'.$tout;binmode $out;
open my$in, '<'.$tin;binmode $in;
while(<$in>) {
    substr $_, -$seplen, $seplen, undef;
    $out->print('['.$_.']') if length && !/^[\t\r\n0 ]+$/o;
}
close $in;
close $out;

print $tin, "\n", $tout, "\n";
PM MAIL ICQ Skype   Вверх
amg
Дата 27.3.2007, 08:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


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

Репутация: 38
Всего: 50
Nab, потестировал твой новый код. По потреблению памяти все осталось по-прежнему, зато заметно увеличилась скорость. Теперь compress_array_grep - абсолютный чемпион smile . compress_array не использует дополнительную память, но у него есть такая неприятная особенность - с увеличением размера массива (каждый следующий набор данных в таблице соответствуют удвоенному массиву) резко растет время (кстати, ровно такая же ситуация с кодом tishaishii)
Код

Разреженный массив    Время Память  Время Память  Время Память  Время Память
-----------------------------------------------------------------------------
me1                   0.089 13-1    0.167 24-14   0.702 91-63   1.932 179-123
compress_array        0.198 11-1    0.532 18-14   9.044 63-63  36.59  123-123
compress_array_map    0.135 13-1    0.269 21-14   1.087 80-63   2.132 157-123
compress_array_grep   0.080 12-1    0.164 20-14   0.658 75-63   1.296 147-123

 
PM MAIL   Вверх
tishaishii
Дата 27.3.2007, 10:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Создатель
***


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

Репутация: 4
Всего: 8
Прошу прощения, проблемы со связью.
Цитата
кстати, ровно такая же ситуация с кодом tishaishii

Ну если ты не будешь хранить весь массив в оперативке, как у меня в примере для лучшего понимания, а когда-то запишешь однажды в файл с  разделителями, то память меняться почти не должна. Смысл-то цикл делать для записи в файл, в котором нет проверки на пустоту, а потом открывать этот файл, разбирать и заново его фильтровать. Вобщем, если будешь только читать из файла с разделителями, то будешь без напрягов работать с большими массивами, независимо от оперативки и подкачки.  Откуда ей рости во время чтения.

Это сообщение отредактировал(а) tishaishii - 27.3.2007, 10:42
PM MAIL ICQ Skype   Вверх
G0rinich
Дата 4.4.2007, 15:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: 1
Просто красивый код )))
Код

#!/usr/bin/perl

sub clean_arr{
push@_=>undef;
defined$_[0]||
defined$_[-1]?
push@_=>shift:
shift for 1 ..
@_; pop; (@_)}

@a = clean_arr
( undef,undef,
1,2,3,undef,4,
undef,5,undef,
undef,undef,6,
undef,undef );

print join'-',
@a;


Взято тут

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

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

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


 




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


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

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