Imagerでjpgをサポートさせるためにここのdmgを入れる必要があった気がする。

よね？

use Imager;

my $read_image = Imager->new;

my $image_source = "20080901152.jpg";
$read_image->read(file=>$image_source)
  or die "Cannot load $image_source: ", $read_image->errstr;

my $scaled_image = $read_image->scaleX(pixels=>100)->scaleY(pixels=>100);

$read_image->compose(src=>$scaled_image,
                   tx=>250,       ty=>10);

$read_image->write(file=>'test.jpg')
  or die 'Cannot save test.jpg: ', $read_image->errstr;

composeとかblendもできるのでやりたい事はできそう。

Lingua::JA::Galで朝のあいさつ

print Lingua::JA::Gal->gal("おはようございます");

この読めなさっぷりが面白い。

macbookにCPAN::Miniをいれて、さらにCPAN::Mini::Webserverを導入してみた。

快適！

増補改訂版Java言語で学ぶデザインパターン入門
結城 浩
ソフトバンククリエイティブ / ￥ 3,990 ()
通常24時間以内に発送

package Trouble;
use Moose;

has number => ( isa => 'Str', is => 'ro');

sub getNumber {
  my $self = shift;
  return $self->number;
}

sub toString {
  my $self = shift;
  return "[Trouble " . $self->number . "]";
}

package Support;
use Moose::Role;
use Perl6::Say;
requires 'resolve';

has name => (isa => 'Str', is => 'rw', required => 1);
has next => (isa => 'Support', is => 'rw');


sub setNext {
  my ($self, $next) = @_;
  $self->next($next);
  return $next;
}

sub support {
  my ($self, $trouble) = @_;
  if($self->resolve($trouble)) {
    $self->done($trouble);
  }
  elsif(defined($self->next)) {
    $self->next->support($trouble);
  } else {
    $self->fail($trouble);
  }
}

sub toString {
  my $self = shift;
  return "[" . $self->name . "]";
}

sub done {
  my( $self, $trouble ) = @_;
  say $trouble->toString() . " is resolved by " . $self->toString . ".";
}

sub fail {
  my( $self, $trouble ) = @_;
  say $trouble->toString() . " cannnot be resolved.";
}

package NoSupport;
use Moose;
with 'Support';

sub resolve { return 0; }

package LimitSupport;
use Moose;
with 'Support';
has limit => (isa => 'Int', is => 'rw', required => 1);

sub resolve {
  my ($self, $trouble) = @_;
  if($trouble->getNumber() < $self->limit) {
    return 1;
  }
  else {
    return 0;
  }
}

package SpecialSupport;
use Moose;
with 'Support';

has number => (isa => 'Int', is => 'rw', required => 1);

sub resolve {
  my ($self, $trouble) = @_;
  if($trouble->getNumber() == $self->number) {
    return 1;
  }
  else {
    return 0;
  }
}

package OddSupport;
use Moose;
with 'Support';

sub resolve {
  my ($self, $trouble) = @_;
  if($trouble->getNumber() % 2 == 1) {
    return 1;
  }
  else {
    return 0;
  }
}

package main;
use Perl6::Say;
my $alice   = NoSupport->new(name => "Alice");
my $bob     = LimitSupport->new(name => "Bob", limit => 100);
my $charlie = SpecialSupport->new(name => "Charlie", number => 429);
my $diana   = LimitSupport->new(name => "Diana", limit => 200);
my $elmo    = OddSupport->new(name => "Elmo");
my $fred    = LimitSupport->new(name => "Fred", limit => 300);

$alice->setNext($bob)->setNext($charlie)
  ->setNext($diana)->setNext($elmo)->setNext($fred);

for(my $i=0;$i<500;$i+=33){
  $alice->support(Trouble->new( number => $i));
}

実行

[Trouble 0] is resolved by [Bob].
[Trouble 33] is resolved by [Bob].
[Trouble 66] is resolved by [Bob].
[Trouble 99] is resolved by [Bob].
[Trouble 132] is resolved by [Diana].
[Trouble 165] is resolved by [Diana].
[Trouble 198] is resolved by [Diana].
[Trouble 231] is resolved by [Elmo].
[Trouble 264] is resolved by [Fred].
[Trouble 297] is resolved by [Elmo].
[Trouble 330] cannnot be resolved.
[Trouble 363] is resolved by [Elmo].
[Trouble 396] cannnot be resolved.
[Trouble 429] is resolved by [Charlie].
[Trouble 462] cannnot be resolved.
[Trouble 495] is resolved by [Elmo].

本に忠実な感じで、visitorクラスを。

増補改訂版Java言語で学ぶデザインパターン入門
結城 浩
ソフトバンククリエイティブ / ￥ 3,990 ()
通常24時間以内に発送

package Visitor;
use Moose::Role;
requires 'visit';

package ListVisitor;
use Moose;
use Perl6::Say;
with 'Visitor';

sub visit {
  my ($self, $entry) = @_;
  my $currentdir = "";
  if(ref($entry) eq "File"){
    say $currentdir . "/" . $entry->toString();
  }
  elsif (ref($entry) eq "Directory"){
    say $currentdir . "/" . $entry->toString();
    my $savedir = $currentdir;
    $currentdir = $currentdir . "/" . $entry->getName();
    my $it = $entry->iterator();
    while($it->has_next){
      my $e = $it->next;
      $e->accept($self);
    }
    $currentdir = $savedir;
  }
}

package Element;
use Moose::Role;
requires 'accept';

package Entry;
use Moose::Role;
use Perl6::Say;
with 'Element';
requires 'getName';
requires 'getSize';


sub add {say "method add";}
sub iterator {say "method iterator";}

sub toString {
  my $self = shift;
  return $self->getName() . " (" . $self->getSize() . ")";
}

package File;
use Moose;
with 'Entry';

has name => (isa => 'Str', is => 'rw');
has size => (isa => 'Int', is => 'rw');

sub getName {
  my $self = shift;
  return $self->name;
}

sub getSize {
  my $self = shift;
  return $self->size;
}

sub accept {
  my ($self,$v) = @_;
  $v->visit($self);
}

package Directory;
use Moose;
use MooseX::Iterator;
with 'Entry';
has name => (isa => 'Str', is => 'rw');
has directory  => (isa => 'ArrayRef', is => 'rw', default => sub{[]});

sub getName {
  my $self = shift;
  return $self->name;
}

sub getSize {
  my $self = shift;
  my $size = 0;
  my $it = $self->iterator();
  while ( $it->has_next ) {
    my $e = $it->next;
    $size += $e->getSize();
  }
  return $size;
}

sub add {
  my ($self, $entry) = @_;
  push @{$self->directory}, $entry;
  return $self;
}

sub iterator {
  my $self = shift;
  return MooseX::Iterator::Array->new( collection => $self->directory );
}

sub accept {
  my ($self,$v) = @_;
  $v->visit($self);
}

package main;
use Perl6::Say;

say "Making root entries";
my $rootdir = Directory->new( name => "root" );
my $bindir = Directory->new( name => "bin" );
my $tmpdir = Directory->new( name => "tmp" );
my $usrdir = Directory->new( name => "usr" );
$rootdir->add($bindir);
$rootdir->add($tmpdir);
$rootdir->add($usrdir);

my $vi = File->new( name => "vi", size => 10000 );
my $latex = File->new( name => "latex", size => 20000 );
$bindir->add($vi);
$bindir->add($latex);
my $visit = ListVisitor->new();
$rootdir->accept($visit);

実行

Making root entries
/root (30000)
/bin (30000)
/vi (10000)
/latex (20000)
/tmp (0)
/usr (0)

javaのコードだとvisitメソッドをオーバーロードしてんだけどMooseでもできるのかどうかはわからなかった。

withとextendsの使い分けが微妙にわかってなさげ。このパターンだとsuperが必要ないからか？

directryクラスでのみ必要なメソッドは抽象クラスでエラーにしたい場合どうすべきかちょっとわからない。

デザパタ本のvisitorパターンはインターフェースを抽象クラスで実装していたので、Mooseでもできるかなと試してみた。

package Element;
use Moose::Role;
requires 'accept';

package Entry;
use Moose::Role;

extends 'Element';
requires 'getName';
requires 'getSize'; 

sub add {
  print "method add";
}

sub toStoring {
  my $self = shift;
  return $self->getName . " (" . $self->getSize . ")";
}

Moose::Roleはextendsできない。

Moose::Role does not currently support 'extends' at
/opt/local/lib/perl5/site_perl/5.10.0/Moose/Role.pm line 53
Moose::Role::extends('Element') called at moose_visitor.pl line 12

ドキュメントにも書いてあった。

Mooseでデザパタとデザパタ本を読みながらメモっていく。

増補改訂版Java言語で学ぶデザインパターン入門
結城 浩
ソフトバンククリエイティブ / ￥ 3,990 ()
通常24時間以内に発送

• Adapter
  • handlesで委譲させるべし
• Template Method
  • Moose::Roleで抽象クラス
  • requiresでメソッドの実装を要求
• Factory Method
  • コンストラクタの実装を要求するとこはtemplate method
• Singleton
  • MooseX::Singletonを使う
• Bridge
  • 機能と実装を委譲で緩く結びつける
  • 実装側はMoose::Roleで抽象クラス
• Composite
  • Moose::Roleで抽象クラス
• Visitor
  • あとで
  • デザパタ本のjavaの実装だとacceptメソッドにオーバーロード使っている
• Chain of Responsibility
  • あとで

型による制約とMoose::Roleでインターフェースや抽象クラスが作れるのがよいのかな。

ちょっと余裕が出てきたのでここらでMooseなど

.Netでpython実装とかjavaでpython実装とかそういうのに比べて、perlでperlを変えていくサマはまるで、今週号のハミィのようだと思った。

ピューと吹く!ジャガー1 「ふえとポエムと、時々、オトン」

Happinet(SB)(D) / ￥ 1,980 (2008-07-25)
近日発売　予約可

となるとironpython,jythonはハメ字郎の作る笛の如きものなのかね。

と娘と追いかけっこをしながら思った、週末の夜

Catalyst::View::JSONとjQueryの組み合わせでJSONデータのやりとりは簡単にできるのでたまにグラフを書きたくなったらFlotを使うとよさげな感じ

あんま凝ったことはできないのでちょっとした折れ線グラフかヒストグラムな用途

tickに数字以外のものを表示させるメモ

data:  [[0,2],[1,4],[2,6]]
ticks: [[0, "red"], [1, "brue"], [2, "pink"]]

という感じで　xの値と対応させたい文字列を合わせてticksに指定する。

過半数とるまで、最下位の票を無効にしてもう一度投票し直しまっせっていう問題。

投票者は候補者をランク付けしておいて、一位の候補者が過半数を取っていればいいし、もしそうでなかったら、最下位に投票した投票者の票の次のランクの候補者に票を割り振っていくという。

シュワルツ変換でソートをかけていって、一位が過半数とってたらその候補者をreturnすればいいし、そうでなかったら、最下位候補者を投票の文字列から除いて再度やればいいのはわかったんだけど、　c++での書き方がわからん。

結局こんな感じになってしまった。一位と最下位調べるのにmapで組を作っておいて、イテレータで走査してminとmaxを記憶というやり方までは一緒。そのあと、最下位を消すのがわからなかったけど、この解答ではfindして見つかったindexをeraseしてた、なるほど。

perlだと

@votes = sort {$b->[1] <=> $a->[1]} map {[$_,$votes->{$_}]} split(//,$candidates);

っていうふうにつなげられるのがよいんだけどな。

$ballots = [map {s/$votes[-1]->[0]//;$_ } @$ballots];

あとCだと文字列の置換がまだしっくりこない。

perlの解答

sub outcome {
  my ($candidates, $ballots) = @_;
  my $total = @$ballots;
  return "" if  $total == 0;
  my($votes, @votes);
  while(1) {
    $votes = count_vote($ballots);
    @votes = sort {$b->[1] <=> $a->[1]} map {[$_,$votes->{$_}]} split(//,$candidates);
    return $votes[0]->[0] if($votes[0]->[1] * 2 >= $total);
    $ballots = [map {s/$votes[-1]->[0]//;$_ } @$ballots];
    $candidates =~ s/$votes[-1]->[0]//;
  }
}

sub count_vote {
  my $ballots = shift;
 my $counts = {};
  $counts->{substr($_,0,1)}++ for (@$ballots);
  return $counts;
}

print  outcome("ABC",["ACB", "BCA", "ACB", "BCA", "CBA"]);                       # B
print  outcome("DCBA",["ACBD", "ACBD", "ACBD", "BCAD", "BCAD", "DBCA", "CBDA"]); # B
print  outcome("ACB",["ACB", "BCA", "ACB", "BCA", "ACB", "BCA", "CBA", "CAB"]);  # ""
print  outcome("CAB",["ACB", "BCA", "ACB", "BCA", "ACB", "BCA", "CAB", "CAB"]);  # A
print  outcome("Z",["Z"]);                                                       # Z