среда, 26 ноября 2008 г.

Многоликие объекты

Иногда Perl обвиняют что у него "неправильные объекты". В ответ так и хочется спросить: "у Вас мания "объектно-ориентированного величия" или вы любитель "священных войн"? Кто сказал, что объекты должны быть основаны только на классах?

Вон в List вообще нет "классических" объектов, зато есть CLOS, которая заткнет за пояс многие объектно-ориентированные языки программирования. А в perl, если не нравятся perl5 объекты можно использовать все что угодно, например:

Moose - A postmodern object system for Perl 5.
Mouse - Moose minus the antlers
Class::Prototyped - Fast prototype-based OO programming in Perl
Class::Closure - Encapsulated, declarative class style
Class::Spiffy - Spiffy Framework with No Source Filtering

А сколько разных генераторов классов есть.

Уверен, что и к perl6 будет претензии: дескать зачем так все сложно, зачем эти
role, если можно все можно сделать наследованием?

Ради бога! Делайте, никто не связывает руки. Perl позволяет многое, почти все. Можно даже использовать нижеследующие:

use strict;
use warnings;

use Clone qw(clone);

sub new {
my $protos = ref $_[0] eq "ARRAY" ? shift || [] : [];
my $data = shift || {};
my $methods = shift || {};

my $self;
return $self = sub {
my $method = shift;

if ($method eq "clone") {
return new(clone($protos), clone($data), clone($methods));
}

if ($method eq "add_slot") {
%{$methods} = (%{$methods}, @_);
return $self;
}

if ($method eq "get_slot") {
return $$methods{$_[0]};
}
if ($method eq "slot_names") {
return keys %$methods;
}

if (my $sub = $$methods{$method}) {
return $sub->($self, $data, @_);
}

foreach (@$protos) {
if (my $sub = $_->("get_slot", $method)) {
return $sub->($self, $data, @_);
}
}
}
}


# Пример использования.

use Test::More tests => 12;

my $c1 = new(
{ foo => 3 },
{
foo => sub { my ($self, $data) = @_;
return $$data{foo};
},
add => sub {
my ($self, $data, $delta) = @_;
$$data{foo} += $delta;
return $self;
},
},
);

is($c1->("foo"), 3, "c1");

my $c2 = $c1->("clone");
is($c2->("foo"), 3, "c2");

ok($c1->("add", 2), "c1: add 2");

is($c1->("foo"), 5, "c1");
is($c2->("foo"), 3, "c2");

is($c1->("add", 3)->("foo"), 8, "c1: add 3 and return");


$c1->("add_slot", multiply => sub {
my ($self, $data, $y) = @_;
$$data{foo} *= $y;
return $self;
});

ok($c1->("multiply", 2), "multiply");
is($c1->("foo"), 16, "multiply, get");

ok(ref $c1->("get_slot", "multiply") eq "CODE", "get_slot");

is(join(" ", sort $c1->("slot_names")), "add foo multiply", "slot_names");



my $c3 = new(
[$c1], # inheritance
{ foo => 3 },
{
baz => sub { my ($self, $data) = @_;
return join " ", "baz", $$data{foo};
},
}
);

is($c3->("baz"), "baz 3", "c3, baz");
is($c3->("foo"), 3, "c3, foo");

Так что, если нечто отличается от привычного, не следует стразу обвинять это нечто в "неправильности", может просто мы столкнулись с тем, что является лишь немного другим. Другим, а не неправильным!

четверг, 13 ноября 2008 г.

Использование Perl Data Language для расчета Page Rank

В среде SEO (search engine optimization) долгое время ходила, а может и сейчас продолжает ходить, легенда о том, что добавление ссылки на страницу приводит к "утеканию" с нее Page Rank. Другая легенда гласит, что можно так расставить внутренние ссылки на сайте, что Google Page Rank сайта подскочит до небес.

Вообще-то SEO мне чет-то нравятся: из забавно слушать сразу после обеду, когда ничего делать не хочется, разве что послушать какую-то забавную историю или легенду.

Так вот о Page Rank. Как-то во время одной беседы с SEO, слушая легенду о Page Rank, вспомнил о передаче "Разрушители легенд", которая шла по каналу "Дискавери", и подумал: "а не разрушить ли в среде знакомых SEO некоторые легенды о Page Rank?"

Перед тем как делать скрипт расчета локального Page Rank, заглянул на CPAN. Оказалось, что там имеется модуль Algorithm::PageRank. Но при ближайшем рассмотрении оказалось, что в этом модуле используется какие-то другая формула, а не

PR(A) = (1-d) + d (PR(T1)/C(T1) + ... + PR(Tn)/C(Tn))

(http://infolab.stanford.edu/~backrub/google.html)

Пришлось немного подправить модуль. Во время правки выяснилось, что модуль использует PDL (Perl Data Language, http://pdl.perl.org), но не слишком оптимально.

Кстати, при первом знакомстве с PDL, я столкнулся с подобным нюансом. Объекты pdl можно создавать таким способом:

my $foo = pdl(1 .. n);

Это вектор со значениями от 1 до n. Создавая таким образом объекты, я в один прекрасным момент столкнулся с нехваткой памяти. Расследование того, почему PDL так требователен к памяти, показало, что PDL был напрасно обвинен. В вышеприведенном примере сначала создается perl массив (!), а PDL затем достаются лишь крохи памяти, которые не были использованы perl для создания гигантского массива.

Но вернемся к Page Rank. Поскольку алгоритм расчета ранга прост - решил написать пару строк самостоятельно. Тем более если посмотреть на формулу со стороны матричной алгебры:

R = (1 - d) + d * M * R,

где: R - вертикальный вектор рангов страниц,
M - матрица взвешенных ссылок.

Матрица взвешенных ссылок получаемся посредством деления элементов матрица
ссылок на количество ссылок со ссылающихся станиц.

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

use PDL;
my ($from, $to) = rcols 'links.dat';

Затем определяем максимальной значение, которыми закодированы конкретные страницы:

my $size = 1 + maximum(pdl(maximum($from), maximum($to)));

Это необходимо для создания матрицы связей:

(my $M = zeroes(double, $size, $size))->index2d($to, $from) .= 1;

Функция zeroes создает матрицу, заполненную нулями, а index2d на основе информации от ссылках заменяет значения ее соответствующих элементов единицами.

Из матрицы связей получаем взвешенную матрицу:

$M->inplace->divide($M->sumover->transpose, 0);

inplace говорит, что не будет копирования, а - замена значений по месту.

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

my $R = ones(double, $size);
my $d = 0.85;

Затем за 30 итераций рассчитываем ранг:

for (my $i = 0; $i<=30; $i++) { $R = 1 - $d + $d * $R x $M; }

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

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

wcols sequence($size->sclr), $R->slice(',(0)'), 'r.dat';

Ну вот и все. Надеюсь, я смог заинтересовать вас познакомиться c Perl Data Language.