Recently in Perl Category

Stats on #rtmstats

| Comments | No TrackBacks

Once in a while — well, at the end of a year, actually — Remember the Milk gently suggests you might want to brag to the community how many tasks you have completed in the passing year. Some treat it as a PR plug, some don’t, do as you want. What is interesting is the question: how many tasks others completed?

So I wrote a bunch of simple scripts to search Twitter regularly for #rtmstats, save the results and later parse the numbers from the tweets at large. The code is on the Github.

Below are two graphs showing the gather reports between 27 December 2012 and yesterday. Not much changes recently so I think those will remain accurate.

The first graph shows reports in time. It is a bit harsh, but when you change the roll period value in the field in lower left (i.e. the number of data points to average over) you will see the trend: the earlier the report, the larger number of tasks has been completed. This is of course expected, for when you complete large number of task you probably visit RTM more often and report faster.

The second graph shows the reports sorted by the number of completed tasks. The X axis describes the “top percentage” of the report, e.g. (45.7; 762) means that roughly that if you completed at least 762 tasks, you are in “top 45.7%”.

The power of sets

| Comments | No TrackBacks

A few weeks ago I’ve participated in Code Retreat in Poznań. The main theme of the workshop was not to learn some specific programming techniques, but rather to try working in pairs, in fact in many pairs, five or six, each for less than an hour.

The goal was to program Conway’s Game of Life, where each cell on rectangular board is born, lives or dies depending on the number of live neighbors (the live cell with 2 or 3 live neighbors survives, the dead cell with 3 live neighbors becomes alive).

The most common model is a two dimensional array. However, this approach has a drawback of the need to expand the array in all directions when new cells are to be born. Coding it correctly, with all test cases in less than an hour is not easy.

A friend in one of the pairs had a great idea: forget about an array and keep a set of live cells. Then, in each evolution step, expand this set with newly born cells and remove the ones which don’t survive.

We coded the solution in Ruby (without tests) and Java (with tests, in later session). Below is my personal try in Perl.

The concept can be neatly described in set theory. Let S be the set of live cells, neigh(c) is a function returning all neighbors of cell c. The set of candidates (potentially live cells in next round) is

$$ C = \bigcup_{c\in S} \mathrm{neigh}(c) $$

then the live set in the next round is

$$ S’ = \{ c\in C : |\mathrm{lneigh}(c)|=3 \vee c\in S \wedge |\mathrm{lneigh}(c)|=2 \} $$

\( \mathrm{lneigh}(c) \) being the set of live neighbors of c

$$ \mathrm{lneigh}(c) = \mathrm{neigh}(c) \cap S $$

The first version of code used plain hashes as sets, but using Set::Scalar gives cleaner code. There are some caveats, however.

use warnings;
use strict;

use Test::More;
use Set::Scalar;

# well, this should be default...
*Set::Scalar::Base::_strval  = sub { "$_[0]" };

my @D = (
    [ -1, -1 ], [ -1, 0 ], [ -1, 1 ],
    [  0, -1 ],            [  0, 1 ],
    [  1, -1 ], [  1, 0 ], [  1, 1 ]
);

my $h_rod = Set::Scalar->new(Seq::from_arr([-1,0], [0,0], [1,0]));
my $v_rod = Set::Scalar->new(Seq::from_arr([0,-1], [0,0], [0,1]));

my $set = Set::Scalar->new(Seq::from_arr([1, 2], [3, 4]));
ok $set->has(Seq->new(1,2));  # this wouldn't work without _strval redefinition

$set = $h_rod;

$set = step($set);
is $set, $v_rod;

$set = step($set);
is $set, $h_rod;

done_testing;


sub step {
    my ($live) = @_;
    my $candid = Set::Scalar->new(map { neigh($_) } $live->members);

    return Set::Scalar->new(grep {
        my @c_live_neigh = grep { $live->has($_) } neigh($_);
        @c_live_neigh == 3 || @c_live_neigh == 2 && $live->has($_);
    } $candid->members);
}

sub neigh {
    my ($o) = @_;
    map { Seq->new($o->[0] + $_->[0], $o->[1] + $_->[1]) } @D;
}


package Seq;
use overload '""' => sub {
    return join ",", @{$_[0]};
};

sub new {
    my $class = shift;
    return bless [ @_ ], $class;
}
sub from_arr {
    return map { Seq->new(@$_) } @_;
}

As Jarkko writes in the docs of Set::Scalar:

Using references (or objects) as set members has not been extensively tested. The desired semantics are not always clear: what should happen when the elements behind the references change? Especially unclear is what should happen when the objects start having their own stringification overloads.

Well, this is the case here. As we insert into the set the array refs, we need to convince Set::Scalar that two different refs are the same set element, if only the referred arrays have the same content.

However, stringification overload is not enough, as Set::Scalar additionally uses the refs addresses in its own stringification sub, _strval. So we need to redefine the sub to provide the set with our way of comparing things.

In fact, this was a big surprise to me: none of checked CPAN set distributions allowed the use of own identity methods. Even plain old hash-as-a-set is better in this regard, as stringification is performed to check for key presence:

my %hsh = map { $_ => $_ } ( Seq->new(1,2), Seq->new(3,4), Seq->new(1,2) );
is values(%hsh), 2;

Mapping terminal colors

| Comments | No TrackBacks

Recently I started to work more intensively under Windows. Being a Linux convert, I installed MSYS to have bash and other UN*X tools. Although MSYS works nice, I had problems with proper console behavior. Both the Windows default one (cmd.exe) and Console2 lack some terminal capabilities, so I stick with MSYS’ rxvt.

One thing I didn’t like about rxvt was the colors. I have Tango colors set in Gnome Terminal, so I tried to copy the palette.

Rxvt allows you to set an ANSI color with -colorX options, but accepts only X11 color names, while Gnome Terminal gives you RGB values.

So I wrote a simple script which reads an RGB triple from the input and finds the closest matching colors in the palette. Here it is:

use warnings;
use strict;

use 5.010;
use Color::Similarity::HCL qw( distance );

my ($fname) = @ARGV;
die "Usage: $0 /etc/X11/rgb.txt" unless defined $fname;

my @palette;
open my $xcol_fh, '<', $fname or die "Can't open $fname: $!";
while (<$xcol_fh>) {
    chomp;
    next if /^\s*!/;
    my ($r, $g, $b, $name) = $_ =~ /^\s*(\d+)\s+(\d+)\s+(\d+)\s+(.*)/;
    push @palette, { name => $name, r => $r, g => $g, b => $b };
}
close $xcol_fh;

while (my $l = <STDIN>) {
    chomp $l; 

    my @triple = $l =~ /^\s*(\d+)\s+(\d+)\s+(\d+)/;
    $_->{dist} = distance([ @triple ], [ @$_{qw( r g b )} ]) for (@palette);

    say "Best matches for (", join(qq(, ), @triple), ") are: ";
    my @srt = sort { $a->{dist} <=> $b->{dist} } @palette;
    for my $col (@srt[0..9]) {
        say "$col->{name} (", join(qq(, ), @$col{qw( r g b )}), "): $col->{dist}";
    }   
}

or even simpler, using Convert::Color::X11, as suggested by LeoNerd:

use warnings;
use strict;

use 5.010;
use Convert::Color::X11;
use Color::Similarity::HCL qw( distance );

my @palette = map { { name => $_, rgb => [ Convert::Color::X11->new($_)->rgb8 ] } } Convert::Color::X11->colors;                                                                                                                              

while (my $l = <STDIN>) {
    chomp $l; 

    my @triple = $l =~ /^\s*(\d+)\s+(\d+)\s+(\d+)/;
    $_->{dist} = distance([ @triple ], $_->{rgb}) for (@palette);

    say "Best matches for (", join(qq(, ), @triple), ") are: ";
    my @srt = sort { $a->{dist} <=> $b->{dist} } @palette;
    for my $col (@srt[0..9]) {
        say "$col->{name} (", join(qq(, ), @{$col->{rgb}}), "): $col->{dist}";
    }   
}

For me, rxvt best emulates Tango palette with the following options:

-color0 black -color1 red3 -color2 chartreuse4 -color3 gold3 -color4 DodgerBlue4 -color5 plum4 -color6 turquoise4 -color7 honeydew3 -color8 gray34 -color9 firebrick2 -color10 chartreuse2 -color11 khaki -color12 SkyBlue3 -color13 plum3 -color14 cyan3 -color15 gray93

Per-tags feeds in MovableType

| Comments | No TrackBacks

In Movable Type it is possible to generate a feed for entries matching a given tag only. For this to happen, just select some tag, e.g. from tags cloud and take a look at link named “Feed of results tagged …”. For example, for this blog’s Perl tag, the link looks like:

http://tu.wesolek.net/cgi-bin/mt/mt-search.cgi?tag=Perl&Template=feed&IncludeBlogs=2&limit=20

and you can use this URL as a feed, e.g. for Ironman challenge.

There is a problem with Ubuntu package, however (Karmic at least). Packaged MT is missing search_templates link in /usr/lib/cgi-bin/movabletype. I reported this bug, and you can apply the simple solution on your own.

Perlmonks on giving ready solutions

| Comments | No TrackBacks

I read Perlmonks irregularly, sometimes I even post something. I give hints, thoughts or bigger chunks of code. But for the first time I got as much as 40% of downvotes on an entry that I think is rather neutral.

I understand that some people don’t like to give others ready solutions, they prefer “to teach others to fish than to give them a fish”. But is it really something that bothers them so much to give thumbs down to the ones who don’t mind? No feelings hurt, I’m just curious…

Compiling Perl 5.10.1 under Ubuntu

| Comments | No TrackBacks

Note: Since 5.10.1 is not upstream, there might be changes in packages versions, so downloading patches as described below might not work. I’ll try to update this entry to reflect the correct links, but in case of problems just go to http://patch-tracker.debian.org/package/perl, select the current version of Perl 5.10.1 and download mod_paths.diff manually.


After reading encouragingly simple instructions on compiling Perl 5.10.1, I decided to compile Perl — for the first time — on my own.

Everything went fine, but after installation it occurred that the order of directories on @INC is “core, vendor, site”, where the expected — after using Debian’s Perl for years — was “site, vendor, core”. Apparently a bug (for most), with no chance to be corrected due to backward compatibility.

So, I applied a patch from Debian, which corrects the order. Note, that besides correcting the order, the patch adds /etc/perl at the beginning of @INC and /usr/local/lib/site_perl at the end. This is fine with me, but you can remove it from the code if you wish.

mod_paths.diff:

Subject: Tweak @INC so that the ordering is:

    etc (for config files)
    site (5.8.1)
    vendor (all)
    core (5.8.1)
    site (version-indep)
    site (pre-5.8.1)

The rationale being that an admin (via site), or module packager
(vendor) can chose to shadow core modules when there is a newer
version than is included in core.


---
 perl.c |   62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 62 insertions(+), 0 deletions(-)

diff --git a/perl.c b/perl.c
index 94f2b13..5a6744a 100644
--- a/perl.c
+++ b/perl.c
@@ -4879,9 +4879,14 @@ S_init_perllib(pTHX)
     incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE);
 #endif

+#ifdef DEBIAN
+    /* for configuration where /usr is mounted ro (CPAN::Config, Net::Config) */
+    incpush("/etc/perl", FALSE, FALSE, FALSE, FALSE);
+#else
 #ifdef ARCHLIB_EXP
     incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
 #endif
+#endif
 #ifdef MACOS_TRADITIONAL
     {
    Stat_t tmpstatbuf;
@@ -4906,11 +4911,13 @@ S_init_perllib(pTHX)
 #ifndef PRIVLIB_EXP
 #  define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
 #endif
+#ifndef DEBIAN
 #if defined(WIN32)
     incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
 #else
     incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
 #endif
+#endif

 #ifdef SITEARCH_EXP
     /* sitearch is always relative to sitelib on Windows for
@@ -4954,6 +4961,61 @@ S_init_perllib(pTHX)
     incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE);
 #endif

+#ifdef DEBIAN
+    incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, FALSE);
+    incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, FALSE);
+
+    /* Non-versioned site directory for local modules and for
+       compatability with the previous packages' site dirs */
+    incpush("/usr/local/lib/site_perl", TRUE, FALSE, FALSE, FALSE);
+
+#ifdef PERL_INC_VERSION_LIST
+    {
+   struct stat s;
+
+   /* add small buffer in case old versions are longer than the
+      current version */
+   char sitearch[sizeof(SITEARCH_EXP)+16] = SITEARCH_EXP;
+   char sitelib[sizeof(SITELIB_EXP)+16] = SITELIB_EXP;
+   char const *vers[] = { PERL_INC_VERSION_LIST };
+   char const **p;
+
+   char *arch_vers = strrchr(sitearch, '/');
+   char *lib_vers = strrchr(sitelib, '/');
+
+   if (arch_vers && isdigit(*++arch_vers))
+       *arch_vers = 0;
+   else
+       arch_vers = 0;
+
+   if (lib_vers && isdigit(*++lib_vers))
+       *lib_vers = 0;
+   else
+       lib_vers = 0;
+
+   /* there is some duplication here as incpush does something
+      similar internally, but required as sitearch is not a
+      subdirectory of sitelib */
+   for (p = vers; *p; p++)
+   {
+       if (arch_vers)
+       {
+       strcpy(arch_vers, *p);
+       if (PerlLIO_stat(sitearch, &s) >= 0 && S_ISDIR(s.st_mode))
+           incpush(sitearch, FALSE, FALSE, FALSE, FALSE);
+       }
+
+       if (lib_vers)
+       {
+       strcpy(lib_vers, *p);
+       if (PerlLIO_stat(sitelib, &s) >= 0 && S_ISDIR(s.st_mode))
+           incpush(sitelib, FALSE, FALSE, FALSE, FALSE);
+       }
+   }
+    }
+#endif
+#endif
+
 #ifdef PERL_OTHERLIBDIRS
     incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE);
 #endif
-- 
tg: (daf8b46..) debian/mod_paths (depends on: upstream)

So, my modified compilation instructions with Ubuntu’s “taste” look like:

wget http://www.cpan.org/modules/by-authors/id/D/DA/DAPM/perl-5.10.1.tar.bz2
wget http://patch-tracker.debian.org/patch/series/dl/perl/5.10.1-7/debian/mod_paths.diff
tar xjf perl-5.10.1.tar.bz2
cd perl-5.10.1
patch -b -p1 <../mod_paths.diff
perl Configure -de -Dprefix=${HOME}/local -Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Doptimize=-O2
make
make test
make install

About this Archive

This page is an archive of recent entries in the Perl category.

Movable Type is the previous category.

Find recent content on the main index or look in the archives to find all content.

Pages

OpenID accepted here Learn more about OpenID