僕のIT革命

「Perlにもしあったらいいなぁと思う機能」は大体Perl6にあると思う

2011-03-14T18:51:00.004+09:00

2011-03-19: 複数行コメントについて加筆しました。

背景

Perlにもしあったらいいなぁと思う機能 - サンプルコードによるPerl入門を読んでて「それPerl6でできるよ」と思ったので。一応Perlです。一応。

1. ダブルクォーテーションの中で関数が展開できる機能

ダブルクォート(qq演算子)はエスケープシーケンス、スカラ、配列、ハッシュ、関数、クロージャを展開します:

"aaa { $book.title } bbb"

Qクォート演算子でオレオレ展開ルールも作れます(Rakudoだとまだ動きませんが):

Q:function/funcall: &func()/;
Q:closure/closure: { ucfirst('hello') ~ ', world' }/;

# qq//と同じ
Q:qq/$scalar, @array[], %hash{}, &subroutine(), { 'closure' }/;

2. メソッドにおけるオブジェクトの名前

自身をselfで参照できます:

class Foo {
  has Str $.objective = 'world';
  method greet {
    say "Hello, { self.objective }";
  }
}
Foo.new.greet; # Hello, world
Foo.new(:objective<Perl6>).greet; # Hello, Perl6

3. データを簡単にダンプする標準関数

オブジェクトをPerl6コードにダンプする.perlメソッドがあります:

say 42.perl; # 42
say { foo => 'bar', hoge => qw/fuga piyo/ }.perl; # {"foo" => "bar", "hoge" => ("fuga", "piyo")}

デバッグ用には変数名が分かり易いようにペア記法を組み合わせて、noteで標準エラー出力に書き出します(warnは例外を投げるので注意):

my $obj = Foo.new(:objective<Perl6>);
note :$obj.perl; # "obj" => Foo.new(objective => "Perl6")

4. ファイルの内容を一度に読み込むモジュール

slurpが組み込み関数（と組み込みオブジェクトのメソッド）です。ファイルオープンに失敗すると例外を投げます:

open('filename').slurp;
slurp 'filename';

でもこれってPerl5でもFile::Slurpとか色々ある気がする。

5. Mojo::Base程度の小さなクラスビルダー

最初からまともなOO機能が付いてきます:

class Vector2D {
  has Num $.x = 0;
  has Num $.y = 0;
  method squared_norm() { [+] ($.x, $.y).map: (* ** 2) }
  method norm() { self.squared_norm.sqrt }
}

class Vector3D is Vector2D {
  has Num $.z = 0;
  method squared_norm() { [+] ($.x, $.y, $.z).map: (* ** 2) }
}

multi sub prefix:<~>(Vector3D $v --> Str) { "<{ $v.x }, { $v.y }, { $v.z }>" }
multi sub infix:<->(Vector3D $v, Vector3D $u --> Vector3D) {
  my ($x, $y, $z) = ($v.x, $v.y, $v.z) Z- ($u.x, $u.y, $u.z);
  Vector3D.new(:$x, :$y, :$z);
}

my $v = Vector3D.new(:x(1), :y(3.sqrt));
my $u = Vector3D.new(:x(1), :z(1));
my $delta = $v - $u;
say "{ ~$v } norm: { $v.norm }"; # <1, 1.73205080756888, 0> norm: 2
say "{ ~$u } norm: { $u.norm }"; # <1, 0, 1> norm: 1.4142135623731
say "{ ~$delta } norm: { $delta.norm }"; # <0, 1.73205080756888, -1> norm: 2

6. Net::FTPのコマンドが失敗したときは自動的に例外を投げてほしい

好みの問題なのでパス。サブクラス作ってオーバーライドするのがセオリーでしょうか。

7. ハッシュスライスと配列スライスのための関数

リファレンスはAutovivifyされるので必要ありません:

my %hash = foo => 'hoge', bar => qw/hoge fuga/, baz => 'piyopiyo';
my $hash_ref = %hash;
my @slice = $hash_ref<foo bar>; # ('hoge', ('hoge', 'fuga'))

8. Perlの最新の機能とstrictとwarningsとutf8とautodieをレキシカルに有効にするプラグマ

strict/warnings/autodie相当はデフォルト。Unicode関連はまだ策定中のようですが、Rakudoだと文字列はUTF-8です。

9. 複数行コメント

これはPerl6でもPODで書くことになっています(S02)。=begin commentと=end commentで囲むか、=for commentで空行までをコメントにします。 POD処理系は知らない(あるいはコメントだと知っている)フォーマットの内容は出力しないので、ドキュメントと混ざるとかそういう心配はありません。

ちなみに=cutは必要なくなりました（というか、なくなりました）。

もう1つ、埋め込みコメント(Embedded comment)という範囲を指定したコメントも利用できます。#`に続けて好きな区切り子を使って囲みます(ただし#は駄目):

say 'hello, ' ~ #`( コメントは空白扱いなので文中に出現しても構わない ) 'world';
$obj\ #`( 空白が許されない場所ではUnspaceで取り除く必要がある ).method;

#`{{
  複数行コメントの例。カッコは重ね打ちもできる。
  この場合数と種類が対応した閉じカッコが出現するまでがコメントとして扱われる。
  } まだ閉じない。
  } ここもまだコメントの中。
}} # ここで閉じられる

#`/* Cっぽくしたいならこう書ける(*は単なるコメントの一部) */
#`「Unicodeでカッコとして定義された文字なら何でも使える。誰得」

埋め込みコメントの区切り子の扱いはQクォート演算子と同じです。

蛇足ですが2つめの例で$obj\ #`( ... )`.sayとあるのはPerl6がオペランドと後置演算子(ここではメソッド呼び出しの.)の間に空白の出現を許していないためで、バックスラッシュは余分な空白を取り除くためのものです。この機能はUnspaceと呼ばれています。Cプリプロセッサやシェルで行末に置くバックスラッシュを他の空白やコメントにも一般化したものと思えば大体合ってます。

部分継続チュートリアル

2011-03-10T01:52:00.004+09:00

この文書について

これはCommunity Scheme Wikiで公開されているcomposable-continuations-tutorial（2010年09月30日版）の日本語訳です。

誤字脱字・誤訳などがありましたらコメントあるいはメールで御指摘いただけると幸いです。

本訳は原文のライセンスに基づきCreative Commons Attribution-ShareAlike 2.0 Genericの下で公開されます。

本文

部分継続(Composable continuation)は継続区間を具象化することで制御を逆転させるものです。ウンザリするほど複雑な概念を表す長ったらしいジャーゴンのように聞こえますが、実際はそうではありません。今からそれを説明します。

resetとshiftという2つのスペシャルフォームを導入するところから始めましょう[1]。 (reset expression)は特別な継続を作るなりスタックに目印を付けるなりしてからexpressionを評価します。簡単に言えば、expressionが評価されるとき、あとから参照できる評価中の情報が存在するということです。実際にはshiftがこの情報を参照します。(shift variable expression)は目印のついた場所、つまりresetを使った場所にジャンプし、その場所からshiftを呼び出した場所までのプログラムの断片を保存します; これはプログラムの区間を「部分継続」として知られる組み合わせ可能な手続きに具象化し、この手続きにvariableを束縛してからexpressionを評価します。

組み合わせ可能(Composable)という語はその手続きが呼び出し元に戻ってくるため、他の手続きと組み合わせられることから来ています。 Composable continuationの別名として例えば限定継続(Delimited continuation)や部分継続(Partial continuation)もありますが、ここでは一貫して「組み合わせ可能」という用語を使います(訳注: 日本語では「部分継続」が訳語としてメジャーなので、この語を用いることにします)。組み合わせ可能という特性はcall-with-current-continuatonが生成する「脱出継続」と違う部分です。脱出継続は戻ってきません——というより、制御をプログラムの別の場所に戻す効果があります——が、部分継続は戻ってきます。

部分継続を呼び出すと、制御をshiftが呼ばれた場所に戻します。しかしresetに渡された式が評価された位置に制御が続けて戻るときは、resetが呼ばれた位置に戻るのではなく、部分継続手続きが呼び出された位置に戻るのです!

別の説明としてコード変形を示してみます[2]:

(reset (...A... (shift V E) ...B...))
; -->
(let ((V (lambda (x) (...A... x ...B...))))
  E)

(reset E)
; -->
E

一連の例が意味を理解するのに役立つでしょう。まず最初に、shiftがない(reset expression)は末尾再帰を考えなければexpressionの評価と同じです。

(+ 1 (reset (+ 2 3)))
;Value: 6

(cons 1 (reset (cons 2 '())))
;Value: (1 2)

次にshiftを加えます。shiftで作られた部分継続を呼び出さなければ、shiftは自身とそれを動的スコープで内包しているresetの間の一切を捨てる効果があります。

(+ 1 (reset (+ 2 (shift k
                   ;; Kは無視
                   3))))
;Value: 4

(cons 1 (reset (cons 2 (shift k
                         ;; kは無視
                         (cons 3 '())))))
;Value: (1 3)

問題: もし(reset ... shift)内でkを適用したらどうなるでしょう?

次に部分継続を使ってみましょう。これは(lambda (x) (+ 2 x))や(lambda (x) (cons 2 x))と同じになります; これはresetに渡した式のshift呼び出しをすべて引数xで置き換えた1引数関数を作ることで確認できます。これこそが「制御の逆転」の意味するところです: プログラムの評価の一部が関数として具象化されているのです。

(+ 1 (reset (+ 2 (shift k
                   (+ 3 (k 4))))))
; -->
(+ 1 (let ((k (lambda (x) (+ 2 x))))
       (+ 3 (k 4))))
; -->
(+ 1 (+ 3 (+ 2 4)))
;Value: 10

(cons 1 (reset (cons 2 (shift k
                         (cons 3 (k (cons 4 '())))))))
; -->
(cons 1 (let ((k (lambda (x) (cons 2 x))))
          (cons 3 (k (cons 4 '())))))
; -->
(cons 1 (cons 3 (cons 2 (cons 4 '()))))
;Value: (1 3 2 4)

さらに、部分継続は複数回呼び出すこともできます; プログラムの一部を実行する単なる関数であり、何度も同じ部分を実行することができます。

(+ 1 (reset (+ 2 (shift k
                   (+ 3 (k 5) (k 1))))))
; -->
(+ 1 (let ((k (lambda (x) (+ 2 x))))
       (+ 3 (k 5) (k 1))))
; -->
(+ 1 (+ 3 (+ 2 5) (+ 2 1)))
;Value: 14

(cons 1 (reset (cons 2 (shift k
                         (cons 3 (k (k (cons 4 '()))))))))
; -->
(cons 1 (let ((k (lambda (x) (cons 2 x))))
       (cons 3 (k (k (cons 4 '()))))))
; -->
(cons 1 (cons 3 (cons 2 (cons 2 (cons 4 '())))))
;Value: (1 3 2 2 4)

これらの例は多分恣意的で、実用的ではないように見えるでしょう。実際これらの例は恣意的ですが、その目的はshiftとresetを簡潔な方法で説明するところにありました。式変形は手作業で行うこともできますが、shiftとresetの威力は全体的なコード変形を必要としない点にあります。 shiftとresetは抽象の境界を越えて、字句的に手が届かないスコープの動的な制御をも逆転させることができます; つまり、部分継続はプログラムの様々な点を把握せずとも、その一部を関数に詰め込むことができるということです。

もっと洗練された例を挙げましょう。for-eachのような手続があったとして、for-eachやその類の手続が受け付けるようなコレクションを受け取ってその要素の遅延ストリームを返す手続を作りたいとします。これはcall-with-current-continuation3つとset!を使って作ることができます。胃腸や心臓が弱い方は見ないほうが良いでしょう。

(define (for-each->stream-maker for-each)
  (stream-lambda (collection)
    (call-with-current-continuation
      (lambda (return-cdr)
        (for-each
          (lambda (element)
            (call-with-current-continuation
              (lambda (return-to-for-each)
                (return-cdr
                  (stream-cons element
                    (call-with-current-continuation
                      (lambda (return-next-cdr)
                        (set! return-cdr return-next-cdr)
                        (return-to-for-each))))))))
          collection)
        (return-cdr stream-null)))))

明らかにこれは不細工です。コードが入れ子の深みに降りていくのに合わせてインデントが素敵なスロープを描いていますが、このコードを考えているときに思い浮かぶことは優雅さという概念についての考えだけでしょう。しかしながら、このパターンはshiftとresetが抽象化しているものによく似ています。

return-cdrはresetで評価される式の継続を表しています; これにはコレクションを走査する間、連続した出力ストリームのcdrを返すためにreturn-next-cdrが代入されます。shift同様、保存しておきたいプログラムの一部に入った時点で継続を具象化―—return-to-for-each——し、次のresetする位置、つまりreturn-cdrに脱出しています。保存した一部を使いたくなったら、あたかも部分継続を呼び出すように継続——これはストリームが次に返すcdrの継続——をreturn-next-cdrとして具象化し、それをreturn-cdrに代入してプログラムの一部が次にどこに戻れば良いか分かるようにしてから、return-to-for-eachを呼び出してプログラムの一部をもう一度実行しています。

これはshiftとresetを使ってもっとずっと簡単に表現できます：

(define (for-each->stream-maker for-each)
  (stream-lambda (collection)
    (reset (begin
             (for-each (lambda (element)
                         (shift k
                           (stream-cons element (k))))
                       collection)
             stream-null))))

脚注

[1] スペシャルフォームの代わりに(reset thunk)と(shift receiver)という手続きを使うこともできますが、簡潔さとカラム幅、それから一般的な使い方で一行に収まるようにそうしませんでした。 controlとprompt——このページのほとんどの例で同じ結果になるもう一対のよく知られた制御演算子——もあることを覚えておいて下さい。

[2] この変形は厳密には正しくありません、本当はもう少しresetを置く必要があります。詳細はこの文書の範囲から外れる上、入れ子になったshiftとresetを使うときしか関係のないことです。が、完備性のため、必要ならここに完全な変形を示しておきます:

(reset (...A... (shift K E) ...B...))
; -->
(let ((K (lambda (x) (reset (...A... x ...B...)))))
  (reset E))

(reset E)
; -->
E

(ラムダ式の内側のresetだけがshift/reset演算子とcontrol/prompt演算子の相違点です)

実装

Riastradh氏によるshiftとresetの実装はcall-with-current-continuationに基づいており、非常に重く実用には低速ですが、可搬性があります。

Oleg氏によるバージョンは継続が必要とする部分だけをキャプチャするのにトランポリンを使っています。これはメモリリークがないという利点を持ちますが、このトランポリンは「空の」継続の中に置くべきで、また期待する動作のためにcall/ccを変更する必要があります。

PLT Scheme(訳注: Racketに改名しています)のscheme/controlライブラリにはshift/resetやその他多数の制御演算子が論文へのリンク付きで収録されています。

GasbichlerとSperber両氏による論文「Final Shift for Call/cc: Direct Implementation of Shift and Reset」は様々な実装技術の詳細を掘り下げています(Sperber氏のオンラインで公開されている論文)。

BrainMac

2011-03-08T23:35:00.001+09:00

Macユーザーに馴染み易いプログラミング言語はどんなものかと考えたとき、当然それはApple関連のキーワードだけでプログラムできる言語に違いありません。

そういうわけで作りました。

package Language::BrainMac;

use 5.010;
use strict;
use warnings;
use parent qw/Language::BF/;

sub bm2bf(_) {
  my $token = shift;
  given ($token) {
    return '+' when /^OS[89X]$/i;
    return '-' when /^iOS$/i;
    return '>' when /^NeXT$/i;
    return '<' when /^Apple$/i;
    return ',' when /^Mac$/i;
    return '.' when /^i(?:Phone|Pad|Pod)$/i;
    return '[' when /^Steve$/i;
    return ']' when /^Jobs$|^Woz(?:niak)?$/i;
    return $_;
  }
}

sub code {
  my ($self, $code) = @_;
  $self->SUPER::code(join ' ', grep $_, map bm2bf, split /\s+/, $code);
}

{
  no warnings qw/once/;
  *parse = \&code;
}

1;

Language::BFのcodeメソッドをオーバーライドしてトークン置き換えているだけです。やってることはOokと同じわけで、つまりMacユーザーはオランウータンと(ry

Hello worldはこんな感じで書けます。~~マカー脳の恐怖~~非常に分かり易いですね:

#!/usr/bin/env perl

use 5.010;
use strict;
use warnings;
use Language::BrainMac;

my $bm = Language::BrainMac->new(do { local $/; <DATA> });
$bm->run;
say $bm->output;

__DATA__
OSX OSX OSX OSX OSX OSX OSX OS9 OSX OSX Steve iOS NeXT OSX OSX OSX OSX OSX OSX OSX OSX OSX OSX Apple Jobs NeXT OSX OSX OSX OSX iPhone
iOS iOS iOS iPhone
OSX OSX OSX OSX OSX OSX OSX iPod iPad
OSX OSX OSX iPhone
NeXT OSX OSX OSX OSX OSX OSX OSX OSX OSX OSX iPhone
NeXT OSX OSX OSX OSX OS8 Steve iOS NeXT OSX OSX OSX OSX OSX OSX OSX OSX Apple Woz NeXT iPad
Apple Apple Apple OSX OSX OSX OSX OSX OSX OSX OSX OSX OSX iPad
Apple OSX OSX OSX OSX Steve iOS NeXT iOS iOS iOS iOS iOS Apple Jobs NeXT iPod
Apple OSX OSX OSX Steve iOS NeXT OSX OSX OSX OSX OSX Apple Jobs NeXT iPhone
NeXT NeXT NeXT iOS iOS iOS iOS iOS iOS iOS iOS iPod
Apple Apple Apple Apple OSX OSX OSX OSX Steve iOS NeXT iOS iOS iOS iOS iOS Apple Wozniak NeXT OSX iPhone
OSX OSX OSX OSX OSX OSX iPad
iOS iOS iOS iOS iOS iOS iPad
OSX OSX OSX OSX OSX OSX OSX OSX iPod
OSX OSX OSX OSX OSX iPhone
NeXT NeXT NeXT OSX OSX OSX OSX OSX OSX OSX OSX OSX iPhone
Apple Apple iPad

実行結果:

hello
(yet again)

Perl 5 to 6 - カリー化

2011-03-07T16:15:00.001+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 28 - Curryingの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 28 - カリー化

SYNOPSIS

use v6;

my &f := &substr.assuming('Hello, World');
say f(0, 2);                # He
say f(3, 2);                # lo
say f(7);                   # World

say <a b c>.map: * x 2;     # aabbcc
say <a b c>.map: *.uc;      # ABC
for ^10 {
    print <R G B>.[$_ % *]; # RGBRGBRGBR
}

DESCRIPTION

カリー化、あるいは部分適用とは関数やメソッドにいくつかの引数を与えて関数を生成する処理のことです。これは打鍵数を節約し、また他の関数にコールバック関数を渡したいときに便利です。

"Hello, World"から簡単に部分文字列を取り出せる関数が欲しいと仮定しましょう。古典的なやり方は専用の関数を書くことです:

sub f(*@a) {
    substr('Hello, World', |@a)
}

`assuming`によるカリー化

Perl6のコードオブジェクトはassumingメソッドを持ちます。これは呼び出し元のコードオブジェクトに引数を適用し、その部分適用された関数を返します。

my &f := &substr.assuming('Hello, World');

これでf(1, 2)がsubstr('Hello, World', 1, 2)と等価になります。

演算子は単に変な名前のサブルーチンなので、assumingは演算子に対しても使えます。与えられた数に2を足すサブルーチンが欲しければ次のように書けます

my &add_two := &infix:<+>.assuming(2);

しかしこれは長ったらしすぎるので、別の方法があります。

Whatever-Starによるカリー化

my &add_two := * + 2;
say add_two(4);         # 6

このアスタリスクスはWhateverと呼ばれ、引数のプレースホルダです。したがって式全体はクロージャを返します。複数のWhateverを1つの式に含めることもでき、その場合*の項を形式的パラメータで置き換え、複数の引数を取るクロージャが作られます。つまり* * 5 + *は-> $a, $b { $a * 5 + $b }と等価です。

my $c = * * 5 + *;
say $c(10, 2);                # 52

2番目の*は項ではなく中置演算子なのでWhateverによるカリー化の対象ではないことに注意して下さい。

Whateverを使った式のクロージャへの昇格は構文に基づいてコンパイル時に行われます。これはつまり

my $star = *;
my $code = $star + 2

はクロージャを生成せず、次のようなメッセージを出してdieするということです。

Can't take numeric value for object of type Whatever

Whateverによるカリー化にはassumingよりも多様な使い方があります。最初の引数以外も簡単にカリー化できるからです:

say  ~(1, 3).map: 'hi' x *    # hi hihihi

これは文字列繰り返し演算子であるinfix:<x>の第2引数をカリー化しているので、数値引数で呼び出されるとその数だけhiを連結した文字列を生成するクロージャを返します。

メソッドの呼び出し元オブジェクトをWhateverにすることもできます。よって

say <a b c>.map: *.uc;      # ABC

は引数に対してucメソッドを呼び出すクロージャになります。

MOTIVATION

Perl5で関数プログラミングができることはMark Jason DominusがHigher Order Perlで明らかにしています。

Perl6はこれをもっと簡単にしようと試みており、関数プログラミングの典型的な構造を作るための使い易いツールを提供しています。カリー化とクロージャの容易な生成は関数プログラミングの鍵となるもので、例えばmapやgrepと組み合わせて使うデータ変換を非常に簡単に書けるようにします。

Perl 5 to 6 - 一般的なPerl6データ処理イディオム

2011-03-07T15:51:00.002+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 27 - Common Perl 6 data processing idiomの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 27 - 一般的なPerl6データ処理イディオム

SYNOPSIS

# キーと値のリストからハッシュを作る:
# 方法1: スライス
my %hash; %hash{@keys} = @values;
# 方法2: メタ演算子
my %hash = @keys Z=> @values;

# 配列の各要素に真を対応づけたハッシュを作る:
my %exists = @keys Z=> 1 xx *;

# 値を指定された範囲に制限する。ここでは範囲は 0..10
my $x = -2;
say 0 max $x min 10;

# デバッグ用: 変数の内容を変数名込みでSTDERRに書き出す
note :$x.perl;

# 大文字小文字を区別せずにソートする
say @list.sort: *.lc;

# 必須アトリビュート
class Something {
    has $.required = die "Attribute 'required' is mandatory";
}
Something.new(required => 2); # エラーなし
Something.new()               # ブーン

DESCRIPTION

ある言語で生産性を発揮するには言語仕様を学ぶだけでは不十分です。むしろ具体的な問題の解法を覚えておく必要があります。イディオムと呼ばれる一般的な使用法のパターンは、あなたが問題に直面したときに毎回車輪の再発明をしなくとも良いように手助けしてくれます。

そこでPerl6でデータを扱う一般的なイディオムをいくつか集めました。

ハッシュ

# キーと値のリストからハッシュを作る:
# 方法1: スライス
my %hash; %hash{@keys} = @values;
# 方法2: メタ演算子
my %hash = @keys Z=> @values;

最初の方法はPerl5で使われていたものと同じです: スライスへの代入です。 2番目の方法はZip演算子Zを使っています。これはリストをジッパーのように連結します: 1, 2, 3 Z 10, 20, 30は1, 10, 2, 20, 3, 30になります。 Z=>はメタ演算子で、Zipを=>(ペア生成演算子)と組み合わせています。つまり1, 2, 3 Z=> 10, 20, 30は1 => 10, 2 => 20, 3 => 30と評価されます。これをハッシュ変数に代入するとハッシュに変換されます。

存在チェックの場合、ハッシュの値はそれが真理値コンテキストでTrueと評価されさえすれば何でも良いことがしばしばあります。このような場合に配列あるいはキーのリストからハッシュを初期化する良い方法は

my %exists = @keys Z=> 1 xx *;

これは右辺に遅延評価される1の無限リストを使っており、Zは短い方のリストが使い切られた時点で止まることを利用しています。

数値

どこからか数値を取得し、予め決めた範囲内に収まるよう切り詰めたいことが時々あります(例えば配列の添字として使えるように)。

Perl5では結局$a = $b > $upper ? $upper : $bともう一つ下限の条件を付けることでしばしば対処してきました。中値演算子maxとminを使えば、これはかなり簡潔化できます

my $in-range = $lower max $x min $upper;

$lower max $xはどちらか大きい方の数値を返すので、範囲の下限に切り詰めることになります。

minとmaxは中置演算子なので、演算子自体も切り詰められます:

$x max= 0; $x min= 10;

デバッグ

Perl5にはData::Dumperがあり、Perl6には.perlメソッドがあります。これらは元のデータ構造を可能な限り忠実に再現するコードを生成します。

:$varはペア(「コロンペア」)を生成し、変数名をキーとして使います(ただしシジルは除きます)。つまりこれはvar => $varと同じです。 note()は標準エラーストリームにデータを改行付きで書き出します。したがってnote :$var.perlはデバッグ用に変数の値を名前と一緒に表示する手軽な手段になります。

ソート

Perl5と同様に、組み込みのsortは2引数の比較関数を取ることができ、その比較にしたがってソートを行います。 Perl5と違ってこれはちょっと賢く、関数が引数を1個しか取らない場合は自動的に変換を行ってくれます。

一般に、変換を通した値同士で比較を行いたければPerl5では次のようにできました:

# 注意: ここからPerl5コード
my @sorted = sort { transform($a) cmp transform($b) } @values;

# あるいは、いわゆるシュワルツ変換を使って:
my @sorted = map { $_->[1] }
             sort { $a->[0] cmp $b->[0] }
             map { [transform($_), $_] }
             @values

最初の方法は変換を繰り返し書く必要がある上、比較毎に変換が実行されます。 2番目の方法は変換された値を元の値と一緒に保持することでその問題を回避していますが、コード量がかなり多くなります。

Perl6は変換関数が1引数の場合、2番目の方法を自動化(し、値毎の配列生成を避けることで少しだけ効率化)します:

my @sorted = sort &transform, @values;

必須アトリビュート

アトリビュートの存在を強制する典型的な方法は、コンストラクタ内——複数存在する場合は全コンストラクタ内——で存在確認をすることです。

Perl6でもこれは動きますが、各アトリビュートのレベルで必須にする方が簡単かつ安全です:

has $.attr = die "'attr' is mandatory";

これはデフォルト値の機構を利用しています。値が与えられた場合はデフォルト値生成コードは実行されないのでdieも呼ばれません。いずれかのコンストラクタが値をセットし損ねると例外が投げられます。

MOTIVATION

N/A

Perl 5 to 6 - 例外と制御例外

2011-03-06T22:57:00.001+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 26 - Exceptions and control exceptionsの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 26 - 例外と制御例外

SYNOPSIS

try {
    die "OH NOEZ";

    CATCH { 
        say "there was an error: $!";
    }
}

DESCRIPTION

例外はその名前に反してまったく例外的なものではありません。実際のところPerl6では通常の制御フローの一部です。

例外は潜在的なエラー(例えば0除算、存在しないメソッドの呼び出し、型チェック失敗)またはdieその他の関数の明示的な呼び出しによって生成されます。

例外が投げられるとプログラムは呼び出しフレームからCATCHブロックかtryブロックを探し、スタックを完全に巻き戻します(つまりそれまでに呼び出された全部のサブルーチンから無理矢理戻ってくるということです)。もしCATCHもtryも見つからなければプログラムは終了し、運が良ければ役に立つエラーメッセージが表示されます。どちらか一方が見つかった場合はエラーメッセージは特殊変数$!に格納され、CATCHブロックが実行されます(tryブロックにCATCHブロックがない場合、ブロックはundefを返します)。

ここまでの説明ではまだ例外が例外的なものに思えるかも知れませんが、エラー処理は些末なアプリケーションでもなければ不可欠です。ただそればかりでなく、通常のreturn文も例外を投げているのです!

これは制御例外と呼ばれ、CONTROLブロックで捕捉することができ、そうしない場合はサブルーチン宣言で暗黙的に捕捉されます。

次の例を考えてみて下さい:

use v6;
my $block = -> { return "block"; say "still here" };

sub s {
    $block.();
    return "sub";
}

say s();

return "block"が制御例外を投げ、現在のブロックから抜ける(したがってstill hereは表示されない)のみならず、サブルーチンからも抜けます。これはsub s...宣言で捕捉されます。ペイロード——この例では文字列——は戻り値として渡され、最後の行のsayがこれを表示します。

$block.()をtry { ... }ブロックの中に入れたりCONTROL { ... }ブロックをサブルーチンの本体に置いたりすることで例外を捕捉できます。

他のプログラミング言語とは逆にCATCH/CONTROLブロックはエラーが捕捉されるスコープの(外ではなく)中にあり、字句的変数への完全なアクセスが与えられています。このことは役に立つエラーメッセージを作るのを容易にし、またエラーが処理される前にDESTROYブロックが実行されることを防ぎます。

投げられない例外

Perl6はマルチスレッドの、特に自動並列化の考えを取り入れています。 1スレッドの終了が全スレッドに影響することがないように、「ソフトな」例外が考案されました。

関数がfail($obj)を呼ぶと特別な未定義値を返します。これはペイロードに$obj(大抵の場合はエラーメッセージ)とバックトレース(ファイル名と行番号)を格納しています。この特殊な未定義値を確認なしに処理しようとすると通常の例外が投げられます。

my @files = </etc/passwd /etc/shadow nonexisting>;
my @handles = hyper map { open($_) }, @files;

この例のhyper演算子はmapに可能な限り動作を並列化するよう伝えます。 nonexistingファイルのオープンに失敗した場合、通常のdie "No such file or directory"では他のファイルオープン処理も中断してしまいます。しかし失敗したオープン処理は代わりにfail("No such file or directory")を呼ぶので、呼び出し元は@handlesの内容を確認することができ、完全なエラーメッセージにもアクセスできます。

ソフトな例外が気に入らない場合、プログラムの最初にuse fatal;と書くとfail()から生じる例外が即座に投げられるようになります。

MOTIVATION

良いプログラミング言語にはエラー状態を扱うための例外が必要です。成功したかどうか戻り値をいつも確認することは厄介だし忘れがちです。

伝統的な例外は暗黙の並列化にとっては有害なことがあるので、両者の最上の部分を組み合わせる解法が必要でした: 一度にすべてを殺してしまわず、またどんな情報も取りこぼしてしまわない方法がです。

Perl 5 to 6 - 交差メタ演算子

2011-03-05T16:52:00.001+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 25 - The Cross Meta Operatorの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 25 - 交差メタ演算子

SYNOPSIS

for <a b> X 1..3 -> $a, $b {
    print "$a: $b   ";
}
# 出力: a: 1  a: 2  a: 3  b: 1  b: 2  b: 3

.say for <a b c> X 1, 2;
# 出力: a1\n a2\n b1\n b2\n c1\n c2\n

DESCRIPTION

交差演算子Xは2つ以上のリストのデカルト積を返します。つまりどういうことかというと、最初のリストから1つ取って最初の要素に、2番目のリストから1つ取って2番目の要素に、といった具合で作り得るすべての組を返します。

Xの後に演算子を付けるとそれが組のすべての要素に対して適用され、その結果が代わりに返されます。よって1, 2 X+ 3, 6は1+3, 1+6, 2+3, 2+6(当然4, 7, 5, 8と評価されます)を返します。

MOTIVATION

2つ以上のリストの取り得る組み合わせをすべて走査しなければならないことはよくあります。交差演算子はそれを1つの走査に濃縮できるので、プログラムを簡潔にし、字下げのレベルを1つ減らせます。

メタ演算子としての使用法は時としてループを完全になくすことができます。

Perl 5 to 6 - 縮約メタ演算子

2011-03-05T01:26:00.000+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 24 - The Reduction Meta Operatorの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 24 - 縮約メタ演算子

SYNOPSIS

say [+] 1, 2, 3;    # 6
say [+] ();         # 0
say [~] <a b>;      # ab
say [**] 2, 3, 4;   # 2417851639229258349412352

[\+] 1, 2, 3, 4     # 1, 3, 6, 10
[\**] 2, 3, 4       # 4, 81, 2417851639229258349412352

if [<=] @list {
    say "ascending order";
}

DESCRIPTION

縮約メタ演算子[...]は結合性のある中置演算子なら何でもリスト演算子に変換します。これはあたかもリストの各要素間にその中置演算子が置かれたかのように働きます。つまり[op] $i1, $i2, @restは$i1 op $i2 op @rest[0] op @rest[1] ...と書かれたのと同じ結果になります。

これは+演算子を総和関数に格上げし、~演算子を(セパレータを空文字列にした)joinにするなど、非常に強力な構文です。もし関数プログラミングに触れたことがあるなら、(LispやHaskellの)foldlとfoldrを多分ご存知でしょう。これらとは異なり[...]は元の演算子の結合性に従うので、[/] 1, 2, 3は(1 / 2) / 3(左結合)として解釈され、[**] 1, 2, 3は正しく1 ** (2 ** 3)(右結合)として扱われます。

他のすべての演算子と同様に空白は使うことができないので、[+]とは書けますが[ + ]は駄目です。

比較演算子は連結することができるので、こんな風に書いたりもできます

if    [==] @nums { say "all nums in @nums are the same" }
elsif [<]  @nums { say "@nums is in strict ascending order" }
elsif [<=] @nums { say "@nums is in ascending order"}

代入演算子でさえ縮約することができます:

my @a = 1..3;
[=] @a, 4;          # @a[0] = @a[1] = @a[2] = 4; と同じ

[...]がいつもスカラを返すことを覚えておいて下さい。なので[,] @listは[@list]と同じです。

部分結果の取得

バックスラッシュを使った特別な形式が在ります: [\+]のような形式です。これは部分評価結果のリストを返します。つまり[\+] 1..3は1, 1+2, 1+2+3というリストを返します。当然これは1, 3, 6です。

[\~] 'a' .. 'd'     # <a ab abc abcd>

右結合の演算子は右から左へ評価していくので、部分結果もその順になります:

[\**] 1..3;         # 3, 2**3, 1**(2**3) これは 3, 8, 1

縮約演算子は複数組み合わせることができます:

[~] [\**] 1..3;     # "381"

MOTIVATION

プログラマは怠惰であり、2項演算子をリストの全要素に適用するためだけにループなど書きたくないものです。 List.reduceが同様の機能を持ちますが、これはメタ演算子ほどには簡潔でありません([+] @listは@list.reduce(&infix:<+>)になります)し、結合性の面倒を見てくれません。

納得できないなら、この機能を使ってちょっと遊んでみて下さい(Pugsがほとんど実装しています)。本当に楽しいです。

Perl 5 to 6 - クォートと構文解析

2011-03-03T23:04:00.002+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 23 - Quoting and Parsingの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 23 - クォートと構文解析

SYNOPSIS

my @animals = <dog cat tiger>
# or
my @animals = qw/dog cat tiger/;
# or 

my $interface = q{eth0};
my $ips = q :s :x /ifconfig $interface/;

# -----------

sub if {
    warn "if() calls a sub\n";
}
if();

DESCRIPTION

クォート

Perl6には強力な文字列クォート機構があり、文字列のあらゆる機能を完全に制御できます。

Perl5にはシングルクォート、ダブルクォートそしてqw(...)(空白で分割するシングルクォート文字列リスト)があり、さらにq(...)とqq(...)がそれぞれシングルクォートとダブルクォートの同義語になっていました。

一方のPerl6にはQというクォート演算子が定義されていて、様々な修飾子を取ります。 :b(バックスラッシュ)修飾子はバックスラッシュによる\nのようなエスケープシーケンスの展開を許し、:s修飾子はスカラ変数の展開を許し、:cはクロージャ("1 + 2 = { 1 + 2 }")の展開を許す、などなど。また:wはqw/.../が行うように単語を分割します。

これらの修飾子は自由に組み合わせることができます。例えばスカラだけ展開し、他は展開しないqw/.../を作りたくはないでしょうか。まったく問題在りません:

my $stuff = "honey";
my @list = Q :w :s/milk toast $stuff with\tfunny\nescapes/;
say @list[*-1];                     # with\nfunny\nescapesと表示

利用できる修飾子のリストを示します。これはS02からほとんどそのまま盗んできました。これらはすべて長い名前も持ちますが、ここでは省略します。

機能
    :q          \\と\q及び\'を展開する
    :b          その他の\nや\tのようなエスケープシーケンスも展開する
演算
    :x          シェルコマンドとして実行し、結果を返す
    :w          空白で分割する
    :ww         同上。クォートで囲まれた部分は分割しない
文字列展開
    :s          スカラを展開する     ($stuff)
    :a          配列を展開する       (@stuff[])
    :h          ハッシュを展開する   (%stuff{})
    :f          関数を展開する       (&stuff())
その他
    :c          クロージャを展開する ({code})
    :qq         :s、:a、:h、:f、:c、:bを展開する
    :regex      正規表現として解釈する

簡単のためにいくつか短い形式があります:

q       Q:q
qq      Q:qq
m       Q:regex

修飾子が短い形式の場合、:も省略して1語として書くことができます:

シンボル     元の形
qw          q:w
Qw          Q:w
qx          q:x
Qc          Q:c
# などなど

ただし、Perl5プログラマが見落としそうな動作しない形式が1つあります: Perl6では小カッコを使ってqw(...)と書くことはできません。これはサブルーチンqwの呼び出しとして解釈されます。

構文解析

これが構文解析の起点です: すべてのidentifier(...)という形式はサブルーチン呼び出しとして解釈されます。そう、全部です。

if($x<3)

はサブルーチンifの呼び出しと解釈されます。空白を使って曖昧性を解消できます:

if ($x < 3) { say '<3' }

あるいは単にカッコを取り去って:

if $x < 3 { say '<3' }

これはつまりPerl6にはキーワードがないということです。正確に言えばuseとかifのようなキーワードがありますが、これらは特別の構文の中で使われたときだけ特別扱いされます。

MOTIVATION

クォート修飾子の様々な組み合わせは既に内部的に使われています。例えば<...>を解析するq:wやm/.../を解析する:regexです。これらをユーザにも解放して柔軟性を向上させ、使いたいクォートの省略記法を提供するマクロを簡単に書けるようにすることは道理にかなっています。

またキーワードの特別性を制限することで、「キーワード」の定義を書き換えたい時に後方互換性の問題を大幅に減らすことができます。

Perl 5 to 6 - 派生型

2011-03-03T01:35:00.002+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 21 - Subset Typesの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 21 - 派生型

SYNOPSIS

subset Squares of Int where { .sqrt.Int**2 == $_ };

multi sub square_root(Squares $x --> Int) {
    return $x.sqrt.Int;
}
multi sub square_root(Num $x --> Num) {
    return $x.sqrt;
}

DESCRIPTION

Javaプログラマは型のことをクラスかインタフェース(不具なクラスのようなもの)のように考えがちですが、その見方はPerl6においては狭すぎます。型はもっと一般的に、コンテナが値に与えることができる制約です。「古典的な」制約はクラスXあるいはそれを継承したクラスのインスタンスであることです。 Perl6にもXクラスのインスタンスだとかYロールを実装しているとか、あるいはオブジェクトに対してこのコード片が真を返すといった制約があります。最後に挙げたのが最も一般的なもので、これは派生型(Subset type)と呼ばれています:

subset Even of Int where { $_ % 2 == 0 }
# これで他の型名と同様にEvenが使えるようになった

my Even $x = 2;
my Even $y = 3; # 型不一致エラー

(試してみて下さい。Rakudoは派生型を既に実装していますが、派生型に基づいた多重ディスパッチはまだ実装されていません)(訳注: Rakudo* v2011.01で確認したところ、既に実装されているようです)

シグネチャで無名派生型を使うこともできます:

sub foo (Int where { ... } $x) { ... }
# あるいは変数を前に出して
sub foo ($x of Int where { ... } ) { ... }

MOTIVATION

コードの形で任意の型制約を許すことは究極の拡張性を与えてくれます: 現状の型システムが気に喰わなくとも、派生型による自分の型システムで包むことができます。

また、これはライブラリを容易に拡張可能にします: 扱えないデータに対して死ぬ代わりに、サブルーチンやメソッドは「悪い」データが単に多重ディスパッチャによって排除されると宣言できます。もし排除されていたデータを誰かが扱いたくなったら、同名でそのデータを処理できる多重サブルーチンを簡単に追加できます。この方法で例えば実数を扱う数学ライブラリを複素数を扱えるように拡張できます。

Perl 5 to 6 - (似非)XMLのグラマー

2011-03-02T00:42:00.002+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 20 - A grammer for (pseudo) XMLの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

注記: XMLに関する用語の誤用(「整形式」と「妥当」を混同しているなど)がありますが、あくまで例なので原文通りに残しています。

NAME

"Perl 5 to 6" Lesson 20 - (似非)XMLのグラマー

SYNOPSIS

grammar XML {
    token TOP   { ^ <xml> $ };
    token xml   { <text> [ <tag> <text> ]* };
    token text {  <-[<>&]>* };
    rule tag   {
        '<'(\w+) <attributes>*
        [
            | '/>'                 # 空タグ
            | '>'<xml>'</' $0 '>'  # 開始タグと終了タグ
        ]
    };
    token attributes { \w+ '="' <-["<>]>* '"' };
};

DESCRIPTION

これまでの連載記事の焦点はPerl6言語であり、実装状況は気にしていませんでした。これが空想上の言語でないことを示すため、またグラマーの能力を証明するために、このレッスンでは基本的なXMLを解析する、Rakudoで実行できるグラマーの開発をお見せします。

Rakudoの入手とビルドはhttp://rakudo.org/how-to-get-rakudoの指示にしたがって自分で行って下さい。

XMLの概念

私たちの用途の範囲ではXMLは非常に単純です: プレーンテキストと入れ子になったタグから成り、タグは属性を持つことがあります。妥当なXMLであると(あるいはそうでないと)解析させたいテストケースをちょっとだけ用意しました:

my @tests = (
    [1, 'abc'                       ],      # 1
    [1, '<a></a>'                   ],      # 2
    [1, '..<ab>foo</ab>dd'          ],      # 3
    [1, '<a><b>c</b></a>'           ],      # 4
    [1, '<a href="foo"><b>c</b></a>'],      # 5
    [1, '<a empty="" ><b>c</b></a>' ],      # 6
    [1, '<a><b>c</b><c></c></a>'    ],      # 7
    [0, '<'                         ],      # 8
    [0, '<a>b</b>'                  ],      # 9
    [0, '<a>b</a'                   ],      # 10
    [0, '<a>b</a href="">'          ],      # 11
    [1, '<a/>'                      ],      # 12
    [1, '<a />'                     ],      # 13
);

my $count = 1;
for @tests -> $t {
    my $s = $t[1];
    my $M = XML.parse($s);
    if !($M  xor $t[0]) {
        say "ok $count - '$s'";
    } else {
        say "not ok $count - '$s'";
    }
    $count++;
}

これは「良い」XMLと「悪い」XMLのリスト、そしてXML.parse($string)を呼び出してテストを走らせる小さなスクリプトです。言語全体にマッチするルールはTOPという名前にする約束になっています。

(テスト1で分かるように単一のルートタグを必須にしていませんが、この制限を追加するのは些細なことです)

グラマーの開発

XMLのキモは当然タグの入れ子構造ですから、まず2番目のテストに着目することにしましょう。テストスクリプトの先頭に以下のコードを置いて下さい:

grammar XML {
    token TOP   { ^ <tag> $ }
    token tag   {
        '<' (\w+) '>'
        '</' $0   '>'
    }
};

それからスクリプトを実行します:

$ ./perl6 xml-01.pl
not ok 1 - 'abc'
ok 2 - '<a></a>'
not ok 3 - '..<ab>foo</ab>dd'
not ok 4 - '<a><b>c</b></a>'
not ok 5 - '<a href="foo"><b>c</b></a>'
not ok 6 - '<a empty="" ><b>c</b></a>'
not ok 7 - '<a><b>c</b><c></c></a>'
ok 8 - '<'
ok 9 - '<a>b</b>'
ok 10 - '<a>b</a'
ok 11 - '<a>b</a href="">'
not ok 12 - '<a/>'
not ok 13 - '<a />'

つまりこれは一対の開始タグと終了タグのペアを解析する単純なルールであり、妥当でない4つのXMLをきちんと排除できています。

1番目のテストも同様に簡単に通るように、次のコードを試して下さい:

grammar XML {
    token TOP   { ^ <xml> $ };
    token xml   { <text> | <tag> };
    token text  { <-[<>&]>*  };
    token tag   {
        '<' (\w+) '>'
        '</' $0   '>'
    }
};

(<-[...]>は否定形の文字クラスだったことを思い出して下さい)

それから実行します:

$ ./perl6 xml-03.pl
ok 1 - 'abc'
not ok 2 - '<a></a>'
(残りはさっきと同じ)

どうして2番目のテストは動かなくなったのでしょう? その理由はRakudoが最長トークンマッチをまだ実装しておらず、順番にマッチングを行っているからです。 <text>は空文字列に(つまりいつでも)マッチするので、<text> | <tag>は<tag>とのマッチングを試しません。選択肢の順番を入れ替えると動きます。

しかし我々はプレーンテキストかタグだけを適当にマッチさせたいのではなく、両者のランダムな組合わせをマッチさせたいのでした:

token xml   { <text> [ <tag> <text> ]*  };

([...]はキャプチャしないグループであり、Perl5の(?: ...)と同様です)

いやはや驚くことに、これは最初の2つのテストを両方とも通過します。

3番目のテスト.<ab>foo</ab>ddは開始タグと終了タグの間にテキストがあるので、次はこれを受理しなければいけません。しかしタグの間に出現できるのはテキストに限らず任意のXMLで在り得るので、<xml>を単に呼ぶことにしましょう:

token tag   {
    '<' (\w+) '>'
    <xml>
    '</' $0   '>'
}

./perl6 xml-05.pl
ok 1 - 'abc'
ok 2 - '<a></a>'
ok 3 - '..<ab>foo</ab>dd'
ok 4 - '<a><b>c</b></a>'
not ok 5 - '<a href="foo"><b>c</b></a>'
(残りはさっきと同じ)

これで属性(href="foo"のやつ)に集中することができます:

token tag   {
    '<' (\w+) <attribute>* '>'
    <xml>
    '</' $0   '>'
};
token attribute {
    \w+ '="' <-["<>]>* \"
};

しかしこれでは新しいテストを通過できるようにはなりません。その原因はタグ名と属性の間にある空白です。 \s+や\s*を色んな場所に加える代わりに、tokenをrule(:sigspace修飾子を暗黙的にセットします)に切り替えることにします:

rule tag   {
    '<'(\w+) <attribute>* '>'
    <xml>
    '</'$0'>'
};
token attribute {
    \w+ '="' <-["<>]>* \"
};

これで残るテストは最後の2つになりました:

ok 1 - 'abc'
ok 2 - '<a></a>'
ok 3 - '..<ab>foo</ab>dd'
ok 4 - '<a><b>c</b></a>'
ok 5 - '<a href="foo"><b>c</b></a>'
ok 6 - '<a empty="" ><b>c</b></a>'
ok 7 - '<a><b>c</b><c></c></a>'
ok 8 - '<'
ok 9 - '<a>b</b>'
ok 10 - '<a>b</a'
ok 11 - '<a>b</a href="">'
not ok 12 - '<a/>'
not ok 13 - '<a />'

これらは/で閉じられた入れ子になっていないタグを含んでいます。rule tagにこれを追加するのは何の問題もありません:

rule tag   {
    '<'(\w+) <attribute>* [
        | '/>'
        | '>' <xml> '</'$0'>'
    ]
};

全テストが通るようになりました。やった、はじめて作ったグラマーはちゃんと動きます。

さらなるハッキング

グラマーで遊ぶのは遊び方を読むよりずっと楽しいので、これから実装できるものの例を挙げておきます:

&のような実体参照を含むことができるプレーンテキスト
XMLタグ名が数字で開始して良いのかどうか分かりませんが、現在のグラマーはこれを許しています。必要ならXMLの仕様書を調べてグラマーを改造するのも良いでしょう
<![CDATA[ ... ]]>を含むことができるプレーンテキスト。このXML風タグは無視され、<のような文字はエスケープする必要がありません
<?xml version="0.9" encoding="utf-8"?>のようなXML宣言を許容し、すべてを包含する単一のルートタグを要求する本物のXML(テストケースをいくつか修正する必要があります)
マッチオブジェクト$/を再帰的に走査することでXML用のプリティプリンタを実装できます(これは生半可にはいきません; いくつかRakudoのバグを回避しなければいけないかも知れませんし、キャプチャも新しく導入する必要があるかも知れません)

(解答をこのブログのコメント欄に書かないで下さい; 他の人にも楽しませてあげましょう;-)

ハッキングを楽しんで下さい。

MOTIVATION

強力だし、楽しい

Perl 5 to 6 - 正規表現の逆襲

2011-03-01T01:00:00.004+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 19 - Regexes strike backの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 19 - 正規表現の逆襲

SYNOPSIS

# 通常のマッチング:
if 'abc' ~~ m/../ {
    say $/;                 # ab
}

# 暗黙的な:sigspace修飾子を使ったマッチング
if 'ab cd ef'  ~~ mm/ (..) ** 2 / {
    say $1;                 # cd
}

# :sigspace修飾子を使った文字列置換
my $x = "abc     defg";
$x ~~ ss/c d/x y/;
say $x;                     # abx     yefg

DESCRIPTION

正規表現の基本はLesson 07で既に述べたので、役に立つ(が体系立っていない)内容をいくらか補足します。

マッチング

正規表現マッチングのためにグラマーを書かないといけない訳ではなく、昔ながらのm/.../はまだ動きます。新しい兄弟分としてmm/.../形式があり、:sigspace修飾子を暗黙的に有効にします。これは正規表現中の空白を<.ws>ルールで置換するものだったことを思い出して下さい。

このルールのデフォルトは、2つの単語文字で囲まれている(つまりそれぞれが\wにマッチする)場合は\s+にマッチし、さもなくば\s*にマッチします。

文字列置換において:samespace修飾子は<ws>ルールにマッチした空白を保存します。同様に:samecase及び短縮形の:ii(:iの親戚だからです)修飾子は大文字小文字の違いを保存します。

my $x = 'Abcd';
$x ~~ s:ii/^../foo/;
say $x;                     # Foocd
$x = 'ABC'
$x ~~ s:ii/^../foo/;
say $x                      # FOO

これはモジュールFooをすべてBarに改名したいけれど、例えば環境変数がすべて大文字で書かれているときに非常に便利です。:ii修飾子が大文字小文字の違いを自動で保存してくれます。

これは大文字か小文字かという情報を文字毎にコピーしますが、より頭の良いバージョンもあります; :sigspace(短縮形は:s)修飾子と一緒に使うと、大文字小文字のパターンをソース文字列から探します。 .lc、.uc、.lc.ucfirst、uc.lcfirst、lc.capitalize(Str.capitalizeは各単語の最初の文字を大文字にするメソッド)が認識されます。このようなパターンを見つけると置換後の文字列にも適用します。

my $x = 'The Quick Brown Fox';
$x ~~ s :s :ii /brown.*/perl 6 developer/;
# $xは'The Quick Perl 6 Developer'

選択肢

選択肢は相変わらず|で表現されますが、Perl5とは違った意味になります。選択肢を順番にマッチングしていって最初にマッチしたものを取るのではなく、全選択肢を並列にマッチングして最長一致のものを取ります。

'aaaa' ~~ m/ a | aaa | aa /;
say $/                          # aaa

つまらない変更に見えるかも知れませんがこれは広範囲に影響し、また拡張性のあるグラマーにとって極めて重要です。 Perl6はグラマーを使って解析されるので、++$aの++が2つのprefix:<+>トークンではなく1つのトークンとして解析されるのはこのためです。

順番にマッチングする古い方式は||で利用できます:

grammar Math::Expression {
    token value {
        | <number>
        | '(' 
          <expression> 
          [ ')' || { fail("Parenthesis not closed") } ]
    }
    ...
}

{ ... }はクロージャを実行し、その中でのfailの呼び出しは式を失敗させます。この枝は前のマッチング(ここでは')')が失敗したときだけ呼び出されることが保証されているので、解析中に役立つエラーメッセージを出すのに使えます。

選択肢を書く方法は他にもあり、例えば配列を「展開」すると要素の選択肢としてマッチさせることができます:

$_ = '12 oranges';
my @fruits = <apple organge banana kiwi>;
if m:i:s/ (\d+) (@fruits)s? / {
    say "You've got $0 $1, I've got { $0 + 2 } of them. You lost.";
}

自動的に最長一致にマッチする選択肢の構築方法がもう1つあります: 多重正規表現です。これはmulti token nameのように書かれるか、protoを使って次のように書かれます:

grammar Perl {
    ...
    proto token sigil { ... }
    token sigil:sym<$> { <sym> }
    token sigil:sym<@> { <sym> }
    token sigil:sym<%> { <sym> }
    ...
    token variable { <sigil> <twigil>? <identifier> }
}

この例はsigilという多重トークンを表しており、これはsymでパラメータ化されています。短い名前、つまりsigilが使われた場合は全トークンを選択肢としてマッチします。選択肢を書くのにこれは非常に面倒くさいと思うかも知れませんが、これには'$'|'@'|'%'と書くのに比べてとても大きな利点があります: 多重正規表現は容易に拡張可能です。

grammar AddASigil is Perl {
    token sigil:sym<!> { <sym> }
}
# わあ、新しいシジルを持ったPerl6グラマーができたぞ!

さらに、既存の選択肢を上書きすることもできます:

grammar WeirdSigil is Perl {
    token sigil:sym<$> { '°' }
}

このグラマーではスカラーのシジルは°なので、このグラマーはシジルを探すときは毎回$の代わりに°を探索しますが、コンパイラにはそれにマッチした正規表現がsigil:sym<$>であることが分かります。

次のレッスンでは実際の、Rakudoで動作するグラマーをお見せしましょう。

Perl 5 to 6 - スコープ

2011-02-27T23:53:00.003+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 18 - Scopingの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 18 - Scoping

SYNOPSIS

for 1 .. 10 -> $a {
    # ここは$aが見える
}
# ここは$aが見えない

while my $b = get_stuff() {
    # ここは$bが見える
}
# ここでも$bが見える

my $c = 5;
{
    my $c = $c;
    # ここで$cがundefになる
}
# ここでは$cは5

my $y;
my $x = $y + 2 while $y = calc();
# まだ$xが見える

DESCRIPTION

字句的スコープ

Perl6のスコープはPerl5に非常によく似ています。ブロックは新しい字句的スコープを導入します。変数名は最も内側の字句的スコープから探索され、もし見つからなければ一つ外側のスコープを、といった手順で探索されます。 Perl5と同様にmy変数は完全な字句的スコープ変数であり、our宣言はパッケージ変数に字句的スコープを持った別名を作ります。

ただしちょっとした違いがあります: 変数はブロックの宣言された位置より後で可視であり、ブロックのヘッダ(例えばwhileループの条件節など)で宣言された変数はブロック内に限定されません。

スコープを限定したいときはブロックの形式的パラメータが使えます:

if calc() -> $result {
    # ここでは$resultが使える
}
# ここでは$resultが見えない

変数は宣言の直後から可視であり、Perl5のように文の終わりからではありません。

my $x = .... ;
        ^^^^^
        Perl6では$xは可視だが、Perl5では不可視

動的スコープ

形容詞localはtempという名前になり、初期値が与えられないときは(undefではなく)以前の値を使うようになりました。

また不確定(hypothetical)変数と呼ばれる新しい動的スコープ変数もあります。これは例外によってブロックから抜けた場合には以前の値を復元し、そうでない場合には値を保持します。

コンテキスト変数

Perl5でグローバルだったいくつかの変数($!、$_)はPerl6ではコンテキスト変数になりました。これは動的スコープ間で受け渡しされます。

これは昔からあるPerl5の問題を解決します。Perl5ではブロックを抜ける際にDESTROYサブルーチンが呼ばれることがあり、意図せずしてグローバル変数の値を変更してしまうことがありました。例えばエラー変数です:

# 壊れたPerl5コード
sub DESTROY { eval { 1 }; }

eval {
    my $x = bless {};
    die "Death\n";
};
print $@ if $@;         # 何も出力されない

Perl6ではグローバル変数の暗黙的な使用がないのでこの問題は回避されます。

(Perl5.14では$@を変更から保護しようとしており、この例にある問題のほとんどは回避されます)

疑似パッケージ

変数が同名の字句的スコープ変数で隠されているときは、OUTER疑似パッケージを使ってアクセスすることができます

my $x = 3;
{
    my $x = 10;
    say $x;             # 10
    say $OUTER::x;      # 3
    say OUTER::<$x>     # 3
}

同様に関数もCALLERやCONTEXT疑似パッケージから呼び出し元の変数にアクセスすることができます。これらの違いはCALLERが直前の呼び出し元の変数のみにアクセスするのに対して、CONTEXTはUNIXの環境変数のようにはたらきます(コンパイラの内部で$_や$!のような変数を扱うためにだけ使うべきです)。外部の動的スコープから変数にアクセスするためには、変数がis contextとして宣言されていなければなりません。

MOTIVATION

グローバル変数が本当に悪であり、幾多の問題の温床であることは今日では広く知られています。我々はより良いスコープ機構を実装するためのリソースを持っているので、グローバル変数は本質的にグローバルであるデータ(%*ENVや$*PIDのような)にのみ使われています。

ブロックスコープの規則は非常に単純化されました。

Perl5のperlsynドキュメントを引用しておきます; Perl6で同じことは望みません:

注意: 条件ないしループ文修飾子で修飾された"my"文(例えば"my $x if ...")の挙動は
未定義である。"my"変数の値はundefかも知れないし、以前に代入された値であったり、
あるいはそれ以外の何かかも知れない。挙動を信用してはいけない。将来のバージョンのPerl
では今使っているPerlと異なった挙動を示すかも知れない。ここには竜が潜んでいる。

Perl 5 to 6 - Unicode

2011-02-26T22:41:00.004+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 17 - Unicodeの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 17 - Unicode

SYNOPSIS

(なし)

DESCRIPTION

Perl5のUnicodeモデルは大きな弱点に悩んでいました: バイナリとテキストデータに同じ型を使っていたのです。プログラムがネットワークソケットから512バイト読み込んだとすると、それは当然バイト列になります。しかしそれに対して(Perl5で)ucを呼ぶとテキストとして扱われます。推奨されている方法は最初にバイト列をデコードすることですが、サブルーチンがそれを引数として受け取る段階では、それがエンコードされているのかどうか、つまりblobとして扱うべきかテキストとして扱うべきか確実に判断することは不可能です。

一方、Perl6は単なるバイトのコレクションであるBuf型を提供します。またStrは論理的な文字のコレクションです。

論理的な文字という用語にはいささか説明が必要です。正確に言うと、Strは様々な水準の見方ができるオブジェクトです: Byte、CodePoint(Unicodeコンソーシアムが番号を割り当てたものすべて)、Grapheme(書記素; 文字として目に見えるもの)、CharLingua(言語定義文字)。

例えば16進数表記で61 cc 80は(当然)3バイトのバイト列を構成します。しかしこれは2つのコードポイントLATIN SMALL LETTER A(U+0041)とCOMBINING GRAVE ACCENT(U+0300)、あるいは1つの書記素(ブログシステムないしあなたのブラウザが文字を殺してなければ、àのように見えます)を表しているものと見ることもできます。

したがって文字列の長さを単純に調べることはできず、特定の見方に拠る長さを調べる必要があります:

$str.bytes;
$str.codes;
$str.graphs;

charsメソッドもあり、これは現在のUnicode水準(use byteのようなプラグマで指定でき、デフォルトは書記素)における長さを返します。

Perl5ではしばしば間違ってバイト列を文字列に連結してしまう問題が起きます。 Perl6でそのような問題に悩んだときは、文字列連結演算子をオーバーロードして簡単に問題が発生した位置を特定できます:

sub GLOBAL::infix:<~> is deep (Str $a, Buf $b)|(Buf $b, Str $a) {
    die "Can't concatenate text string «"
        ~ $a.encode("UTF-8")
          "» with byte string «$b»\n";
}

エンコードとデコード

IOシステムの仕様は非常に基本的なもので、エンコードとデコード用のレイヤはまだ定義されていません。この記事にSYNOPSISがないのはそのためです。そのような機構が用意されるのは間違いなく、コードは次のようなものになると思われます:

my $handle = open($filename, :r, :encoding<UTF-8>);

正規表現とUnicode

正規表現はUnicode水準を指定する修飾子を取ることができ、m:codes/./は丁度1個のコードポイントにマッチします。修飾子を指定しない場合は現在のUnicde水準が使われます。

(文字にマッチする)\wのような文字クラスはUnicode標準にしたがって動作します。修飾子として大文字小文字の無視(:i)やアクセントの無視(:a)、置換演算子の置換結果に大文字小文字やアクセントを反映するもの(:samecaseと:sameaccent、省略形は:iiと:aa)があります。

MOTIVATION

今日のほとんどのツールやプログラミング言語で文字列を正しく処理するのはとても難しいことです。 Perl5で書かれたWebアプリケーションを作っているとして、長い単語がレイアウトを崩してしまわないように分割したいとしましょう。組み込みのsubstrを使ったりすると、意図せずして書記素が泣き別れになるかも知れません。

Perl6は書記素レベルの文字列操作を組み込みでサポートした最初の主要言語になります。この文字列操作機能はUnicodeを使う上でほとんどの悩みを取払い、(正規表現と連携して)Perl6を文字列処理における最も強力な言語の1つにします。

テキスト用とバイト列用の個別のデータ型はデバッグとイントロスペクションを非常に容易にします。

Perl 5 to 6 - 列挙型

2011-02-26T14:41:00.001+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 16 - Enumsの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 16 - 列挙型

SYNOPSIS

enum bit Bool <False True>;
my $value = $arbitrary_value but True;
if $value {
    say "Yes, it's true";       # 表示される
}

enum Day ('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun');
if custom_get_date().Day == Day::Sat | Day::Sun {
    say "Weekend";
}

DESCRIPTION

列挙型は用途の広い獣です。定数の列挙からなる低レベルのクラスであり、定数は典型的には整数や文字列です(が任意のものが使えます)。

これらの定数は派生型やメソッド、あるいは通常の値のようにふるまいます。 but演算子でオブジェクトに結びつけることができ、これによって列挙型を値に「ミックスイン」できます:

my $x = $today but Day::Tue;

列挙型の型名を関数のように使うこともでき、引数として値を指定できます:

$x = $today but Day($weekday);

こうするとオブジェクトは列挙型の名前(ここではDay)をメソッド名として持ちます:

say $x.Day;             # 1

最初の定数の値は0、その次は1と続きます。ただしペア記法を使って明示的に別の値を指定した場合は別です:

Enum Hackers (:Larry<Perl>, :Guido<Python>, :Paul<Lisp>);

ある値がミックスインされているかどうかはスマートマッチ演算子や.doesメソッドで調べることができます:

if $today ~~ Day::Fri {
    say "Thank Christ it's Friday"
}
if $today.does(Fri) { ... }

曖昧性がない場合、(Friのように)値の名前だけを与えれば良いことを覚えておいて下さい。曖昧な場合は完全な名前であるDay::Friを与える必要があります。

MOTIVATION

列挙型はPerl5の汚染変数に関する「マジック」と(数値として使われた時に警告が出ないよう特別扱いされている)"0 but true"を返すハックの両方を代替します。加えて真理値(Bool)型も提供します。

列挙型はデバッグやトレースのために任意のメタデータを付加する柔軟性と能力をも提供します。

Perl 5 to 6 - ツイジル

2011-02-26T01:40:00.003+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 15 - Twigilsの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 15 - ツイジル

SYNOPSIS

class Foo {
    has $.bar;
    has $!baz;
}

my @stuff = sort { $^b[1] <=> $^a[1]}, [1, 2], [0, 3], [4, 8];
my $block = { say "This is the named 'foo' parameter: $:foo" };
$block(:foo<bar>);

say "This is file $?FILE on line $?LINE"

say "A CGI script" if %*ENV.exists('DOCUMENT_ROOT');

DESCRIPTION

いくつかの変数にはツイジルという第2のシジルがあります。これは基本的にはその変数が「普通」ではないということです。違いはいくつかあり、例えばスコープの違いなどです。

オブジェクトのパブリックな属性とプライベートな属性がそれぞれ.と!というツイジルを持つことは既に紹介しました; それらは通常の変数ではなくselfに結びつけられています。

ツイジル^はPerl5で例外的に扱われていたケースを一般化します。次のように書けます

# 注意: Perl5のコードです
sort { $a <=> $b } @array

$aと$bはstrictプラグマに特別扱いされていました。Perl6には自己宣言された位置的パラメータというコンセプトがあり、このパラメータがツイジル^を持ちます。これはブロックのシグネチャリストに書かれない位置的パラメータで、辞書順(アルファベット順)に引数を割り当てられます:

my $block = { say "$^c $^a $^b" };
$block(1, 2, 3);                # 3 1 2

したがってこのように書けます

@list = sort { $^b <=> $^a }, @list;
# あるいは:
@list = sort { $^foo <=> $^bar }, @list;

どこにも特別扱いはありません。

位置的引数と名前付き引数の対称性を保つため、ツイジル:が名前付きパラメータに対して同様に働きます。したがって次の2行はほぼ等価です:

my $block = { say $:stuff }
my $sub   = sub (:$stuff) { say $stuff }

ツイジル?は変数や定数がコンパイル時に確定できることを意味します。例えば$?LINEは現在の行番号(以前は__LINE__でした)であり、$?DATAはDATAセクションのファイルハンドルです。

コンテキスト変数にはツイジル*でアクセスできます。なので$*INや$*OUTは動的に上書きできます。

疑似ツイジルとして<があり、$<capture>のように使われます。これは正規表現マッチオブジェクトにアクセスする$/<capture>の省略記法です。

MOTIVATION

Perl5のperlvarドキュメントを読めば、膨大な数の変数があることが分かります。それらの多くはグローバル変数で、プログラムに与える影響も様々です。

ツイジルはそれら特殊変数にある程度の秩序を与える試みであり、また一方で特別扱いされる部分を減らします。オブジェクトの属性の場合はself.varを$.var(とか@.varとかなんとか)と略記できるようにします。

つまるところ、悪化した「句読点ノイズ」はプログラムをよりいっそう一貫性ある、読み易いものにします。

Perl 5 to 6 - MAINサブルーチン

2011-02-26T00:06:00.004+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 14 - The MAIN subの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 14 - MAINサブルーチン

SYNOPSIS

# ファイル doit.pl

#!/usr/bin/perl6
sub MAIN($path, :$force, :$recursive, :$home = '~/') {
    # do stuff here
}

# コマンドライン
$ ./doit.pl --force --home=/home/someoneelse file_to_process

DESCRIPTION

サブルーチン呼び出しと典型的なUNIXプログラムのコマンドラインからの起動は、見た目にはとてもよく似ています: 位置的な引数やオプション、名前付き引数を与えられます。

この類似点のおかげで、Perl6はコマンドラインを処理してサブルーチン呼び出しに変換してくれます。スクリプトは通常通り実行され(この時点で@*ARGSに格納されているコマンドライン引数を書き換えることもできます)、その後もし存在すればMAINサブルーチンが呼び出されます。

コマンドライン引数がMAINサブルーチンの形式的パラメータにマッチしない場合、自動的に生成されたUsageが表示されます。

コマンドラインオプションはサブルーチン引数に以下のようにマップされます:

-name                   :name
-name=value             :name<value>

# <...>はqw(...)のようなものでしたね
--hackers=Larry,Damian  :hackers<Larry Damian>  

--good_language         :good_language
--good_lang=Perl        :good_lang<Perl>
--bad_lang PHP          :bad_lang<PHP>

+stuff                  :!stuff
+stuff=healty           :stuff<healthy> but False

$x = $obj but Falseは$xが$objのコピーではあるけれど、真理値コンテキストではBool::Falseになるという意味です。

これによって、単純な(そしていくつかの単純でない)ケースでは外部のコマンドライン解析器は必要なくなり、単にMAINを使えば良くなりました。

MOTIVATION

この背景にある動機は極めて明確です: 簡単なことは容易に、よく似たことは同様に、そしてほとんどのコマンドライン処理を一行(MAINのシグネチャ)に。

Perl 5 to 6 - カスタム演算子

2011-02-25T16:19:00.003+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 13 - Custom Operatorsの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 13 - カスタム演算子

SYNOPSIS

multi sub postfix:<!>(Int $x) {
    my $factorial = 1;
    $factorial *= $_ for 2..$x;
    return $factorial;
}

say 5!;                     # 120

DESCRIPTION

演算子は変わった名前を持ち、優先度とか結合性のような付加的な属性が少しだけ付いた関数です。 Perl6は通常term infix termというパターンに従います。termは前置演算子が前に付いていたり、後置演算子や後置接周(postcircumfix)演算子が後に付いたりしていても構いません。

1 + 1               中置
+1                  前置
$x++                後置
<a b c>             接周
@a[1]               後置接周

演算子の名前は「特別な」文字に限らず、空白以外なら何でも使えます。

演算子の長い名前はそのタイプの後にコロンとリテラルあるいはシンボルのリストが付きます。例えばinfix:<+>は1+2で使われている演算子です。もう一つの例はpostcircumfix:<[ ]>で、これは@a[0]の演算子です。

これまで得た知識を使えば、もう新しい演算子を定義できます:

multi sub prefix:<€> (Str $x) {
    2 *  $x;
}
say €4;                         # 8

優先度

$a + $b * $cのような式において、infix:<*>演算子はinfix:<+>演算子よりきつい優先度を持ちます。これが式が$a + ($b * $c)と解釈される理由です。

新しい演算子の優先度は既存の演算子との比較で与えることができます:

multi sub infix:<foo> is equiv(&infix:<+>) { ...  }
mutli sub infix:<bar> is tighter(&infix:<+>) { ... }
mutli sub infix:<baz> is looser(&infix:<+>) { ... }

結合性

ほとんどの中置演算子は引数を2つだけ取ります。1 / 2 / 4のような式では、評価の順序は結合性に拠って決められます。 infix:</>演算子は左結合なので、この式は(1 / 2) / 4と解析されます。 infix:<**>(べき乗)のように右結合の演算子の場合、2 ** 2 ** 4は2 ** (2 ** 4)と解析されます。

Perl6には更に多くの結合性があります: noneは同じ優先度の演算子の結合を禁止します(例えば2 <=> 3 <=> 4は禁止されています)。またinfix:<,>はリスト結合性を持ちます。1, 2, 3はinfix:<,>(1; 2; 3)と解釈されます。最後に連結結合性があります: $a < $b < $cは($a < $b) && ($b < $c)と解釈されます。

multi sub infix:<foo> is tighter(&infix:<+>)
                      is assoc('left')
                      ($a, $b) {
    ...
}

後置接周と接周

後置接周演算子はメソッド呼び出しです:

class OrderedHash is Hash {
    method postcircumfix:<{ }>(Str $key) {
        ...
    }
}

$object[$stuff]のようにして呼び出すと$stuffがメソッドの引数として渡され、$objectはselfとして参照可能になります。

接周演算子は通常と違った構文(my @list = <a b c>;のような)に使われることが多いのでマクロとして実装されています:

macro circumfix:«< >»($text) is parsed / <-[>]>+ / {
    return $text.comb(rx/\S+/);
}

is parsedトレイトには区切り子の中の文字列を解析する正規表現を与えます。もし指定しない場合は通常のPerl6コードとして解析されます(新しい構文を導入したいときには、これは望む動作ではないでしょう)。 Str.combはパターンを探し、マッチしたテキストのリストを返します。

既存の演算子の「オーバーロード」

(全部ではないにしろ)既存のほとんどの演算子は多重サブルーチンかメソッドであり、新しい型に合わせてカスタマイズできます。多重サブルーチンを追加することで演算子の「オーバーロード」が実現されます。

class MyStr { ... }
multi sub infix:<~>(MyStr $this, Str $other) { ... }

これは組み込みの「特別な」オブジェクト(StrやIntなど)のようにふるまうオブジェクトを書けるということです。

MOTIVATION

ユーザによる新しい演算子の定義や、既存の演算子の「オーバーロード」を許すことは、ユーザ定義型を組み込み型と同じくらい強力で便利なものにします。もし組み込み型では機能不足になったとしても、コンパイラに変更を加えることなく新しい型に置き換えて状況に対応できます。

これは言語を使うことと言語を改変することのギャップをも取り払います。

Perl 5 to 6 - 遅延性

2011-02-23T00:07:00.004+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 12 - Lazinessの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 12 - 遅延性

SYNOPSIS

my @integers = 0..*;
for @integers -> $i {
    say $i;
    last if $i % 17 == 0;
}

my @even := map { 2 * $_ }, 0..*;
my @stuff := gather {
    for 0 .. Inf {
        take 2 ** $_;
    }
}

DESCRIPTION

Perlプログラマは怠けがちです。彼らが使うリストも。

ここで怠惰という言葉が意味するのは、評価が可能な限り遅延されるということです。 @a := map BLOCK, @bのようなコードを書いたとき、ブロックは一切実行されません。 @aの要素にアクセスしようとしたときだけmapは実際にブロックを実行し、必要とされる分だけ@aを埋めます。

代入ではなくバインディングを使っていることに注意して下さい: 配列への代入は先行評価を強制することがあります(コンパイラがリストの無限性に気づかない限り; 無限リスト検出の詳細はまだ固まっていません)。バインディングはそのようなことがありません。

遅延性は無限リストの取り扱いを可能にします: 引数すべてに操作を行うようなことさえしなければ、評価された要素に必要なだけのメモリしか必要としません。

しかし落とし穴があります: 長さの取得やソートは遅延性を殺します——無限リストであっても。その場合無限ループになるでしょう。

一般にスカラへの変換(例えばList.join)は先行評価です。つまり遅延評価されません。

遅延性は不必要な計算を防ぎ、それによってコードの簡潔性を保ったままパフォーマンスを上げることができます。

Perl5で一行ずつファイルを読む場合、for (<HANDLE>)はファイル全体をメモリに読み込んだ後に走査を始めるのであまり使われませんでした。遅延性があればこれは問題になりません:

my $file = open '/etc/passwd';
for $file.lines -> $line {
    say $line;
}

$file.lineはイテレータか遅延リスト(どっちでも同じことです)なので、行は必要な分だけがディスクから物理的に読み込まれます(当然バッファリングはかませた上で)。

gather/take

遅延リストを作るのに非常に便利な構造がgather { take }です。以下のようにして使います:

my @list := gather {
    while True {
        # 何か計算;
        take $result;
    }
}

gather BLOCKは遅延リストを返します。 @listの要素が必要になるとtakeが実行される位置までBLOCKが走ります。 takeは丁度returnのようなもので、takeされた要素はすべて@listの生成に使われます。 @listの要素がもっと必要になると、ブロックの実行がtakeの直後から再開されます。

gather/takeは動的スコープを持つので、gatherの字句的スコープの外でtakeを呼ぶことができます:

my @list = gather {
    for 1..10 {
        do_some_computation($_);
    }
}

sub do_some_computation($x) {
    take $x * ($x + 1);
}

遅延性の制御

遅延性には固有の問題があり(Haskellを学んだことがあるなら、そのIOシステムが遅延性と無副作用性のためにどれだけ妙なことになっているか気づいたでしょう)、時には遅延して欲しくないものもあります。その場合eagerを先頭に付けるだけです。

my @list = eager map { $block_with_side_effects }, @list;

逆に言うと、リストだけがデフォルトで遅延されます。ただしスカラも遅延させることができます:

my $ls = lazy { $expansive_computation };

MOTIVATION

計算機科学ではほとんどの問題は可能な組み合わせの木として記述され、その中で解が探索されます。効率的なアルゴリズムの鍵は効率的な探索法だけではなく、木の重要な部分だけを生成することでもあります。

遅延リストを使えば、この木と探索法を再帰的に定義し、実際に使っている部分木のみを自動的に生成できます。

一般に遅延性はプログラミングを簡単にします。計算結果がすべて使われるか気にせず済むからです——遅延評価にするだけで、もし結果が使われなければ計算は実行されず、使われたなら何も損していません。

Perl 5 to 6 - Perl5の演算子に対する変更

2011-02-22T19:40:00.003+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 11 - Changes to Perl 5 Operatorsの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 11 - Perl5の演算子に対する変更

SYNOPSIS

# ビット演算子
5   +| 3;       # 7
6   +^ 3        # 6
5   +& 3;       # 1
"b" ~| "d"      # 'f'

# 文字列連結
'a' ~ 'b'       # 'ab'

# ファイルテスト
if '/etc/passwd' ~~ :e { say "exists" }

# 繰り返し
'a' x 3         # 'aaa'
'a' xx 3        # 'a', 'a', 'a'

# 3項演算子
$a == $b ?? 2 * $a !! $b - $a

# 連結比較
if 0 <= $angle < 2 * pi { ... }

DESCRIPTION

数値演算子(+, -, /, *, **, %)はすべて元のままです。

|、^、&はジャンクションの生成に使われるので、ビット演算子は構文が変更されました。それらはデータプレフィクスを伴い、例えば+|は数値コンテキストでのOR、~^は文字列に対する1の補数です。ビットシフト演算子も同様に変更されました。

文字列連結は~になり、.はメソッド呼び出しに使われます。

ファイルテストはペア記法で書かれるようになりました。Perl5の-eは:eになります。 $_以外がファイル名として使われる場合、$filename.IO ~~ :eのようにして与えることができます。

繰り返し演算子xは2種類に分けられました: xは文字列、xxはリストを繰り返します。

これまで$condition ? $true : $falseだった3項演算子は$condition ?? $true !! $falseと書かれます。

比較演算子は連結できるようになりました。$a < $b < $cのように書けば期待した結果が得られます。

MOTIVATION

演算子に対する多くの変更はより良いハフマン符号化を意図しています。つまりよく使われるものには短い名前(メソッド呼び出しの.のような)、そして滅多に使われない演算子には長い名前(文字列に対するビット単位のANDである~&のような)ということです。

連結比較演算子は数学における一般的な記法であり、より自然な言語への前進です。

Perl 5 to 6 - コンテナと値

2011-02-22T16:41:00.002+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 10 - Containers and Valuesの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 10 - コンテナと値

SYNOPSIS

my ($x, $y);
$x := $y;
$y = 4;
say $x;             # 4
if $x =:= $y {
    say '$x and $y are different names for the same thing'
}

DESCRIPTION

Perl6はコンテナと、コンテナに格納できる値を区別して取り扱います。

通常のスカラ変数は一種のコンテナで、型制約やアクセス制約(読み取り専用とか)などの属性を持ち、他のコンテナの別名として使えます。

値をコンテナに格納することを代入と呼び、コンテナに別名をつけることをバインディングと呼びます。

my @a = 1, 2, 3;
my Int $x = 4;
@a[0] := $x;     # @a[0]と$xは同じ変数
@a[0] = 'Foo';   # エラー 「型チェック失敗」

IntやStrのような型は不変、つまりこれらの型のオブジェクトは変更できません。しかしこれらの値を保持する変数(コンテナ)は変更できます:

my $a = 1;
$a = 2;     # 驚くにはあたりません

バインディングは::=演算子を使ってコンパイル時に行うこともできます。

2つの変数がバインディングされているか調べるには=:=比較演算子を使います。

MOTIVATION

サブルーチンや型、変数のエクスポートやインポートは別名定義によって実現されます。ややこしい点のある型グロブによる別名定義マジックに代わって、Perl6はシンプルな演算子を提供します。

Perl 5 to 6 - 比較とマッチング

2011-02-19T22:29:00.001+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 09 - Comparing and Matchingの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 09 - 比較とマッチング

SYNOPSIS

"ab"    eq      "ab"    True
"1.0"   eq      "1"     False
"a"     ==      "b"     True
"1"     ==      1.0     True
1       ===     1       True
[1, 2]  ===     [1, 2]  False
$x = [1, 2];
$x      ===     $x      True
$x      eqv     $x      True
[1, 2]  eqv     [1, 2]  True
1.0     eqv     1       False

'abc'   ~~      m/a/    True
'abc'   ~~      Str     True
'abc'   ~~      Int     False
Str     ~~      Any     True
Str     ~~      Num     False
1       ~~      0..4    True
-3      ~~      0..4    False

DESCRIPTION

Perl6もオペランドをスカラコンテキストで評価する文字列比較演算子(eq, lt, gt, le, ge, ne; cmpはlegになりました)を持っています。同様にPerl5にあった数値比較演算子もまだ残っています。

オブジェクトは単なるblessされたリファレンスではなくなったので、オブジェクト同士を比較する新しい方法が必要です。 ===は全く同一の値に対してのみ真を返します。数値や文字列などの不変型に対しては通常の等価性テストを行い、他のオブジェクトに対しては両辺が同じオブジェクトを参照している場合のみ(C++のアドレス比較のように)真を返します。

eqvは両辺の等価性、つまり同じ型と値を持っているかどうかをテストします。同じ手順で構築されたデータ構造は等価になります。

Smart matching

Perl6には「スマートマッチ」演算子と呼ばれる「何でも比較」演算子があり、~~と書きます。

この演算子は不変型に対しては単に等値性の比較を行います。型とのスマートマッチは型適合性をチェックします。正規表現とのスマートマッチは正規表現とのマッチングを行います。スカラとRangeオブジェクトのマッチングはスカラが範囲内にあるかどうか調べます。

他にももっと高度なマッチングがあります: 例えば引数リスト(Capture)がサブルーチンのパラメータリスト(Signature)と合うかどうか調べたり、(Perl5でいう-eのような)ファイルテスト演算子を適用することができます。

「$xは$yに合うかな？」という疑問はどんなものであれ、Perl6ではスマートマッチとして表現されることを覚えておいて下さい。

Perl 5 to 6 - ジャンクション

2011-02-18T23:54:00.002+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 08 - Junctionsの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 08 - ジャンクション

SYNOPSIS

if $x eq 3|4 {
    say '$x is either 3 or 4'
}
say ((2|3|4)+7).perl        # (9|10|11)

DESCRIPTION

ジャンクションは順序づけられていない値の重ね合わせです。ジャンクションに対する演算はジャンクションの各要素に対して別々に実行(並列化されるかも知れません)され、その結果は同じ型のジャンクションに組み立てられます。

複数あるジャンクション型は真理値コンテキストで評価されたときのみ違いが出ます。型にはany、all、one、noneがあります。

型      中置演算子
any     |
one     ^
all     &

1 | 2 | 3はany(1..3)と同じです。

my Junction $weekday = any <Monday Tuesday Wednesday 
                            Thursday Friday Saturday Sunday>
if $day eq $weekday {
    say "See you on $day";
}

この例では$dayと'Monday'、$dayと'Tuesday'などといった各ペアに対してeq演算子が呼び出され、その結果は再びanyジャンクションに格納されます。結果が確定するなりすぐに(この場合どれか1つでも比較が真になったら)残りの比較は中止できます。

ジャンクションは演算子だけでなく、サブルーチンに対しても機能します:

if 2 == sqrt(4 | 9 | 16) {
    say "YaY";
}

これを可能にするため、ジャンクションは通常の型階層より(ほんのちょっと)外側に位置しています:

                  Mu
                /    \
               /      \
             Any     Junction
           /  |  \
        All other types

もし引数に取ったジャンクションを捕まえて処理するサブルーチンを書きたいなら、パラメータの方をMuかJunctionとして宣言する必要があります。

sub dump_yaml(Junction $stuff) {
    # YAMLがジャンクションを表現できたら良いなあ ;-)
    ....
}

注意: ジャンクションは時々直感に反するふるまいをします。非ジャンクション型では$a != $bと!($a == $b)は常に等しいですが、もし一方の変数がジャンクションだとすると違った結果になることがあります:

my Junction $b = 3 | 2;
my $a = 2; 
say "Yes" if   $a != $b ;       # Yes
say "Yes" if !($a == $b);       # 出力なし

2 != 3は真なので$a != 2|3も真です。一方$a == $bという比較は単一の真理値(True)を返し、その否定はFalseです。

MOTIVATION

Perlは自然言語にかなり近くなるよう設計されており、自然言語ではしばしば「もし結果が$thisであるか結果が$thatであるなら」という代わりに「もし結果が$thisか$thatであるなら」のようにいいます。ほとんどのプログラミング言語では前者(を翻訳したもの)だけが許されており、少しぶきっちょな感じがします。ジャンクションのおかげでPerl6は後者も上手に許可しています。

それ無しにはループが必要になるような大量の比較が非常に簡単に書けるようにもしています。

例として数の配列を思い浮かべ、そのすべての要素が非負であることを知りたいと想像して下さい。 Perl5ではこのようなものを書くことになるでしょう:

# Perl 5コード:
my @items = get_data();
my $all_non_neg = 1;
for (@items){
    if ($_ < 0) {
        $all_non_neg = 0;
        last;
    }
}
if ($all_non_neg) { ... }

あるいはたまたまList::MoreUtilsを知っているなら

use List::MoreUtils qw(all);
my @items = get_data;
if (all { $_ >= 0 } @items) { ...  }

Perl6では短く、かわいらしいものです:

my @items = get_data();
if all(@items) >= 0 { ... }

Perl 5 to 6 - 正規表現(またの名をルール)

2011-02-18T01:08:00.007+09:00

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 07 - Regexes (also called "rules")の日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

NAME

"Perl 5 to 6" Lesson 07 - 正規表現(またの名をルール)

SYNOPSIS

grammar URL {
    token TOP {
        <schema> '://' 
        [<ip> | <hostname> ]
        [ ':' <port>]?
        '/' <path>?
    }
    token byte {
        (\d**{1..3}) <?{ $0 < 256 }>
    }
    token ip {
        <byte> [\. <byte> ] ** 3
    }
    token schema {
        \w+
    }
    token hostname {
        (\w+) ( \. \w+ )*
    }
    token port {
        \d+
    }
    token path {
        <[ a..z A..Z 0..9 \-_.!~*'():@&=+$,/ ]>+
    }
}

my $match = URL.parse('http://perl6.org/documentation/');
say $match<hostname>;       # perl6.org

DESCRIPTION

正規表現(Regex)はPerl6で一番改良のあった領域です。Perl5でそうであったほどに正規ではないので、もはやRegular expressionとは呼ばれません。

訳注: タイトルにある通り「ルール」とも呼ばれるようになりました。この記事でもルールと書いてある部分があります。

大きく3つの変更点と改良点があります。

整理された構文: 書き易さを向上させる多くの細かい変更がなされました。例えば.はすべての文字にマッチするようになり、今までの意味論(改行以外全部)は\Nで提供されるようになりました。修飾子は正規表現の頭に付くようになり、キャプチャしないグループは(?:...)より書き易い[...]になりました。
入れ子のキャプチャとマッチオブジェクト: Perl5では(a(b))(c)のような正規表現はマッチ成功時にはabを$1、bを$2、cを$3にセットしていました。これは変更され、$0(列挙は0から始まります)はab、$0[0]と$/[0][0]がb、$1がcを保持するようになりました。マッチ変数はすべて$/経由でもアクセスできます。これはマッチオブジェクトとも呼ばれ、完全なマッチの木を格納しています。
名前付き正規表現とグラマー: サブルーチンやメソッドのように、正規表現に名前を付けて宣言できます。ルール中で他のルールを<name>のように参照できます。複数の正規表現をグラマーの中に置くことができます。グラマーはクラスのように継承や合成をサポートしています。



これらの変更がルールをPerl5より書き易く、メンテナンスし易いものにしています。

変更点は極めて多岐に渡るので、ここではその上っ面を擦る程度しか紹介できません。

整理された構文

レター文字(アンダースコア、数字とすべてのUnicode letter)はそれ自身にマッチし、バックスラッシュでエスケープされた時は特別の(メタ構文的)意味を持ちます。
それ以外の文字の場合は逆になります——これらはエスケープされないときにメタ構文的な役割を持ちます。

字句通り         メタ構文的
a  b  1  2      \a \b \1 \2
\* \: \. \?     *  :  .  ? 


メタ構文的トークンすべてに意味があるわけではありません(今のところは)。未定義の意味を使うのは不正です。

文字列を正規表現中でエスケープする方法がもう1つあります: クォートすることです。

m/'a literal text: $#@!!'/


.の意味論が変更されたことと、[...]がキャプチャしないグループになったことは既に述べました。
文字クラスは<[...]>、否定形の文字クラスは<-[...]>です。^と$はいつでも文字列の先頭と末尾にマッチします。行の先頭や末尾にマッチさせるには^^と$$を使って下さい。

これは修飾子/sと/mがなくなったということです。修飾子は正規表現の頭に付くようになり、ペアとして書かれます。

if "abc" ~~ m:i/B/ {
    say "Match";
}


修飾子は短い形式と長い形式があります。昔の/x修飾子はデフォルトになりました。つまり、空白は無視されます。

短い形式 長い形式         意味
--------------------------------------------------------------
:i      :ignorecase     大文字小文字の違いを無視する(かつての/i)
:m      :ignoremark     記号を無視する(アクセント記号、分音記号など)
:g      :global         可能な限り繰り返しマッチする(/g)
:s      :sigspace       正規表現中の空白が(省略可能な)空白にマッチする
:P5     :Perl5          Perl5互換の構文に戻す
:4x     :x(4)           4回マッチする(他の数字でも同様)
:3rd    :nth(3)         3番目のマッチ
:ov     :overlap        :gと似ているが、範囲がオーバーラップしたマッチも考慮する
:ex     :exhaustive     マッチ可能性をすべて尽くす
        :ratchet        バックトラックしない


:sigspaceにはもう少し説明が必要です。これはパターン中のすべての空白を<.ws>(ルールwsを呼び出し、結果を保存しません)に置換します。このルールはオーバーライドできます。デフォルトではワード文字列で囲まれている場合は1個以上の空白にマッチし、それ以外の位置では0個以上の空白にマッチします。

(他にも新しい修飾子はありますが、ここに挙げたものよりは重要ではないでしょう)

マッチオブジェクト

すべてのマッチはマッチオブジェクトと呼ばれるものを生成し、特殊変数$/に格納します。
これにはいろいろな使い方ができます。真理値コンテキストではマッチ成功時にはBool::Trueを返します。文字列コンテキストではマッチした文字列を返し、リストとして使われればキャプチャのリストを返します。ハッシュとして使われると名前付きキャプチャを返します。
.fromメソッドと.toメソッドはマッチした先頭と末尾の位置を返します。

if 'abcdefg' ~~ m/(.(.)) (e | bla ) $<foo> = (.) / {
    say $/[0][0];           # d
    say $/[0];              # cd
    say $/[1];              # e
    say $/<foo>             # f
}


$0や$1などは$/[0]や$/[1]などの単なる別名です。同様に$/<x>と$/{'x'}は$<x>という別名を持ちます。

$/[...]や$/{...}でアクセスできるものもまた、マッチオブジェクト(あるいはそのリスト)であることに留意して下さい。
これによってルールの完全な解析木を作ることができます。

名前付き正規表現とグラマー

ルールは旧来のm/.../で使ったり、サブルーチンやメソッドのように宣言することができます。

regex a { ... }
token b { ... }
rule  c { ... }


これらの違いは、tokenは:ratchet修飾子が有効になり(バックトラックしなくなる。Perl5で正規表現の各部を(?>...)で囲むようなもの)、ruleは:ratchetと:sigspaceが有効になることです。
このようなルール(どのキーワードで宣言したかに関係なくルールと呼びます)を呼び出すには、その名前を角カッコで囲みます: <a>。これはサブルールを文字列の現在からマッチさせ、結果を$/<a>に格納します。つまりこれは名前付きキャプチャです。
結果をキャプチャすることなくルールを呼び出すには、名前の先頭にドットを付けます: <.a>。

グラマーはルールの寄せ集めで、クラスに似ています(例えばSYNOPSISを見て下さい)。グラマーは継承したり、ルールをオーバーライドしたりできます。

grammar URL::HTTP is URL {
    token schema { 'http' }
}


MOTIVATION

Perl5の正規表現は解読不能になることがよくありますが、グラマーは巨大な正規表現を小さな読み易い断片に分割することを促進します。
名前付きキャプチャはルールを自己文書化し、多くのものが以前より一貫性ある形になりました。

最後に、グラマーはPerl6を含むほとんどすべてのプログラミング言語を構文解析できるくらい強力です。
このことがPerl6の構文をPerl5よりメンテナンスし易く、変更し易いものにしています(訳注: Perl6の構文はグラマーを使って定義されている)。Perl5では構文解析器はCで書かれており、構文解析時に変更できませんでした。

SEE ALSO

http://perlcabal.org/syn/S05.html



Perl 5 to 6 - コンテキスト
2011-02-16T23:52:00.006+09:00
2011-02-27: コメント欄で既に改訂された仕様の指摘がありましたので一部補足しました。id:uasiに感謝します。

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 06 - Contextsの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

Original text: Copyright© 2008-2010 Moritz Lenz

Japanese translation: Copyright© 2011 SATOH Koichi

NAME

"Perl 5 to 6" Lesson 06 - コンテキスト

SYNOPSIS

my @a = <a b c>
my $x = @a;
say $x[2];          # c
say (~2).WHAT       # Str()
say +@a;            # 3
if @a < 10 { say "short array"; }


DESCRIPTION

次のように書いたとき、

$x = @a


Perl5では$xは@aより少ない情報——@aの要素数だけ——しか持ちません。
すべての情報を保存しておくためには明示的にリファレンスを取る必要があります: $x = \@a

Perl6ではこれらは反対になります: デフォルトでは何も失うことなく、スカラ変数は配列を単に格納します。
これは一般要素コンテキスト(Perl5でscalarと呼ばれていたもの)及びより特化された数値、整数、文字列コンテキストの導入によって可能となりました。無効コンテキストとリストコンテキストは変更されていません。

特別な構文でコンテキストを強制できます。

構文         コンテキスト

~stuff       文字列
?stuff       真理値
+stuff       数値
-stuff       数値 (符号を変える効果もある)
$( stuff )   一般要素コンテキスト
@( stuff )   リストコンテキスト
%( stuff )   ハッシュコンテキスト
@@( stuff )  lolコンテキスト


lolコンテキスト

新しいコンテキストにスライスコンテキストlol(List of List)コンテキスト(コメントで指摘があったので修正しました。多謝)というものもあります。これは内包するリストを展開しないリストコンテキストです。

 @( <a b> Z <c d> )     # <a c b d>
@@( <a b> Z <c d> )     # (['a', 'c'], ['b', 'd'])


これが導入されたのは、多くの組み込み関数が2つのバージョン——フラットなリストを返すバージョンと、リストのリストを返すバージョン——を持っていることが分かったからです。

@@( stuff )でlolコンテキストを強制できます。

MOTIVATION

より特化されたコンテキストは設計上の選択を遅らせる手段になります——例えばスカラコンテキストでリストが何を返すか決めてしまうのは気が早すぎます。リストへのリファレンスはすべての情報を保存していますが、数値比較式の中では役に立ちません。このようにどんな選択も全員を満足させることはできません。

特化コンテキストのおかげでこのような選択をする必要はありません——コンテキストはよく考慮されたデフォルト値を返し、それを望まない演算子は単により特化したコンテキストを伝播させることができます。

それら異なったコンテキストは、マッチオブジェクトのようなオブジェクトの有用性やコードの美しさをより高めます。

SEE ALSO

http://perlcabal.org/syn/S02.html#Context

http://perlgeek.de/blog-en/perl-6/immutable-sigils-and-context.html



Perl 5 to 6 - オブジェクトとクラス
2011-02-15T23:32:00.001+09:00
これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 05 - Objects and Classesの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

Original text: Copyright© 2008-2010 Moritz Lenz

Japanese translation: Copyright© 2011 SATOH Koichi

NAME

"Perl 5 to 6" Lesson 05 - オブジェクトとクラス

SYNOPSIS

class Shape {
    method area { ... }    # リテラル '...'
    has $.colour is rw;
}

class Rectangle is Shape {
    has $.width;
    has $.height;

    method area {
        $!width * $!height;
    }
}

my $x = Rectangle.new(
        width   => 30.0,
        height  => 20.0,
        colour  => 'black',
    );
say $x.area;                # 600
say $x.colour;              # black
$x.colour = 'blue';


DESCRIPTION

Perl6にはPerl5よりずっと洗練されたオブジェクトモデルがあります。クラス、ロール、アトリビュートやメソッドのためのキーワードがあり、カプセル化されたプライベートなアトリビュートやメソッドがあります。
これは(Perl6のオブジェクトシステムに影響を受けた)Perl5のMooseモジュールにとてもよく似ています。

クラスを宣言する方法は2通りあります。

class ClassName;
# ここにクラス定義を書く


1つはclass ClassName;で始まるもので、ファイルの終端までを範囲とします。
もう1つはクラス名にブロックが続くもので、ブロックの中身がクラス定義とみなされます。

class YourClass {
    # ここにクラス定義を書く
}
# 他のクラスやコード


メソッド

メソッドはmethodキーワードで宣言されます。メソッド中ではselfキーワードを使って呼び出し元オブジェクト(Invocant)を参照できます。

シグネチャリストの最初のパラメータに:を付けることで、読み出し元オブジェクトに別名を付けて参照することもできます。

パブリックなメソッドは引数を取らない場合は$object.method、引数を取る場合は$object.method(@args)あるいは$object.method: @argsという構文で呼び出すことができます。

class SomeClass {
    # 何もせずに呼び出し元オブジェクトを返す
    method foo {
        return self;
    }
    method bar($s: ) {
        return $s;
    }
}
my SomeClass $x .= new;
$x.foo.bar                      # $xと同じ


(my SomeClass $x .= newはmy SomeClasss $x .= SomeClass.newの省略形です。型宣言がSomeClassクラスを表すオブジェクトである「型オブジェクト」を補完してくれます)

メソッドはサブルーチンと同様に他の引数も取ることができます。

プライベートメソッドはmethod !method_nameで宣言され、self!method_nameで呼び出せます。

class Foo {
    method !private($frob) {
        return "Frobbed $frob";
    }

    method public {
        say self!private("foo");
    }
}


プライベートメソッドをクラスの外から呼び出すことはできません。

アトリビュート

アトリビュートはhasキーワードで宣言され、シジルの後に特別な文字である「ツイジル(Twigil)」が付きます。プライベートアトリビュートには!、パブリックアトリビュートには.が付きます。
パブリックアトリビュートは単にパブリックなアクセサを持つプライベートアトリビュートです。
したがってアトリビュートの値を変更したい場合は、!ツイジルを使ってアクセサを介さずアトリビュート自身にアクセスする必要があります(アクセサがis rwである場合を除く)。

class SomeClass {
    has $!a;
    has $.b;
    has $.c is rw;

    method set_stuff {
        $!a = 1;    # OK、クラス内からのアトリビュートに対する書き込み
        $!b = 2;    # 同上
        $.b = 3;    # エラー、読み出し専用アクセサには書き込めない
    }

    method do_stuff {
        # パブリックな名前の代わりにプライベートな名前を使えます
        # $!bと$.bは同じものを表します
        return $!a + $!b + $!c;
    }
}
my $x = SomeClass.new;
say $x.a;       # エラー!
say $x.b;       # OK
$x.b = 2;       # エラー!
$x.c = 3;       # OK


継承

継承はisトレイトを使って行います。

class Foo is Bar { 
    # FooクラスはBarクラスから継承する
    ...
}


一般的な継承ルールはすべて適用されます——メソッドはまず実際の型の中で探索され、見つからない場合は親クラスを再帰的に探索します。派生クラスの型は親クラスの型としても振る舞います:

class Bar { }
class Foo is Bar { }
my Bar $x = Foo.new();


この例では$xの型はBarであり、「すべてのFooはBarである」ためFooのオブジェクトが代入できます。

複数のクラスから多重継承できます:

class ArrayHash is Hash is Array { 
    ...
}


ロールと合成

世界は階層的にはできていませんから、何もかもを継承階層に押し込めるのが難しいこともあります。
これがPerl6にロールがある理由の1つです。ロールはクラスにとてもよく似ていますが、直接オブジェクトを作ることはできません。
クラスは型適合性の保証がその第一の目的ですが、ロールはコードの再利用を第一義としています。

role Paintable {
    has $.colour is rw;
    method paint { ... }
}
class Shape {
    method area { ... }
}

class Rectangle is Shape does Paintable {
    has $.width;
    has $.height;
    method area {
        $!width * $!height;
    }
}


SEE ALSO

http://perlcabal.org/syn/S12.html
http://perlcabal.org/syn/S14.html



Perl 5 to 6 - サブルーチンとシグネチャ
2011-02-15T00:24:00.002+09:00
これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 04 - Subroutines and Signaturesの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

Original text: Copyright© 2008-2010 Moritz Lenz

Japanese translation: Copyright© 2011 SATOH Koichi

NAME

"Perl 5 to 6" Lesson 04 - サブルーチンとシグネチャ

SYNOPSIS

# シグネチャなしのサブルーチン——Perl5風
sub print_arguments {
    say "Arguments:";
    for @_ {
        say "\t$_";
    }
}

# 固定引数の型指定付きシグネチャ
sub distance(Int $x1, Int $y1, Int $x2, Int $y2) {
    return sqrt ($x2-$x1)**2 + ($y2-$y1)**2;
}
say distance(3, 5, 0, 1); 

# デフォルト引数
sub logarithm($num, $base = 2.7183) {
    return log($num) / log($base)
}
say logarithm(4);       # 第2引数はデフォルトを利用
say logarithm(4, 2);    # 明示的な第2引数

# 名前付き引数
sub doit(:$when, :$what) {
    say "doing $what at $when";
}
doit(what => 'stuff', when => 'once');  # 'doing stuff at once'
doit(:when<noon>, :what('more stuff')); # 'doing more stuff at noon'
# 不正: doit("stuff", "now")


DESCRIPTION

サブルーチンはsubキーワードで宣言され、CやJavaその他の言語と同様に形式的パラメータを持ちます。これらのパラメータは型制約をとることもできます。

パラメータはデフォルトでは読み出し専用です。この挙動はいわゆる「Trait」で変更できます:

sub foo($bar) {
    $bar = 2;       # 禁止されている
}

my $x = 2;
sub baz($bar is rw) {
    $bar = 0;       # 許される
}
baz($x); say $x;    # 0

sub quox($bar is copy){
    $bar = 3;
}
quox($x); say $x    # まだ0


パラメータは?を後ろに付けたり、デフォルト値を与えることでオプションにできます。

sub foo($x, $y?) {
    if $y.defined {
        say "WE CAN HAZ $y"
    }
}

sub bar($x, $y = 2 * $x) { 
    ...
}


名前付きパラメータ

my_sub($first, $second)のようにしてサブルーチンを呼び出すとき、$firstは最初の形式的パラメータに、$secondは2番目の形式的パラメータに、といった具合に結びつきます。このようなパラメータを「位置的」パラメータと呼んでいます。

数を数えるより名前を思い出す方が簡単なことは往々にしてあるので、Perl6は名前付きパラメータも持っています:

my $r = Rectangle.new( 
        x       => 100, 
        y       => 200, 
        height => 23,
        width  => 42,
        color  => 'black'
);


引数が具体的に何を意味しているか、見るなりすぐに理解できます。

名前付きパラメータを定義するには、単にパラメータの前に:を置くだけです:

sub area(:$width, :$height) {
    return $width * $height;
}
area(width => 2,  height => 3);
area(height => 3, width => 2 ); # 同じ
area(:height(3), :width(2));    # 同じ


ここまでの例では変数名がパラメータの名前としても使われていますが、別の名前を使うこともできます:

sub area(:width($w), :height($h)){
    return $w * $h;
}
area(width => 2,  height => 3);


名前付き引数は名前を使ってのみ渡すことができ、位置による指定はできません。一方で位置的引数は名前を使って渡すこともできます:

sub sqrt($number) { ... };
sqrt(3);
sqrt(number => 3); # これも動く


丸呑み(Slurpy)引数

サブルーチンにシグネチャを付けることは、前もって引数の数を知っておかなければならないということではありません。
残された引数を使い切る、丸呑み(slurpy)パラメータを(通常のパラメータの後に)定義することができます:

sub tail ($first, *@rest){
    say "First: $first";
    say "Rest: @rest[]";
}
tail(1, 2, 3, 4);           # "First: 1\nRest: 2 3 4\n"


変数展開

デフォルトでは配列は引数リストに展開されません。したがってPerl5とは異なり次のようなコードが書けます:

sub a($scalar1, @list, $scalar2){
    say $scalar2;
}

my @list = "foo", "bar";
a(1, @list, 2);                  # 2


これはデフォルトではリストを引数リストとして使えないということでもあります:

my @indexes = 1, 4;
say "abc".substr(@indexes)       # エラー!


プレフィクス|を付けると期待した動作をします:

say "abcdefgh".substr(|@indexes) # bcde


多重サブルーチン

異なるパラメータリストを持つ同名のサブルーチンを複数定義できます:

multi sub my_substr($str) { ... }                          # 1
multi sub my_substr($str, $start) { ... }                  # 2
multi sub my_substr($str, $start, $end) { ... }            # 3
multi sub my_substr($str, $start, $end, $subst) { ... }    # 4


このようなサブルーチンを呼び出すと、パラメータリストが一致するものが選ばれます。

多重サブルーチンは引数の数で区別できる必要はなく、パラメータの型でも区別します:

multi sub frob(Str $s) { say "Frobbing String $s"  }
multi sub frob(Int $i) { say "Frobbing Integer $i" }

frob("x")       # Frobbing String x
frob(2)         # Frobbing Integer 2


MOTIVATION

明示的な型シグネチャの有用性を疑う人はいません: タイピング量は削減され、重複引数の確認は省け、より自己文書化されたコードになります。
名前付きパラメータの価値も既に議論され切っています。

これはまた有用なイントロスペクションを提供します。例えばブロックかサブルーチンをArray.sortに渡したとして、そのコードが1つだけ引数を取るとすると、シュワルツ変換が自動的に行われます——このような機能はPerl5では不可能でした。明示的なシグネチャを欠いているため、sortはコードブロックが何個の引数を取るのか判断できないからです。

多重サブルーチンは組み込み関数を新しい型に対してオーバーライドできるという点で非常に便利です。例えばあなたが(大文字と小文字の変換に独特の規則がある)トルコ語の文字列を正しく扱えるようにローカライズされたバージョンのPerl6を欲しがっているとしましょう。

言語を改変する代わりに単にTurkishStrという新しい型を導入し、組み込み関数に多重サブルーチンを追加するだけです:

multi uc(TurkishStr $s) { ... }


これで文字列が言語に対応した型を持っているかだけ気をつければ、ucを通常の組み込み関数のように使えます。

演算子もサブルーチンなので、これらの改善点は演算子についても同様に働きます。

SEE ALSO

http://perlcabal.org/syn/S06.html



Perl 5 to 6 - 基本制御構造
2011-02-14T16:38:00.010+09:00
これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 03 - Basic Control Structuresの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

Original text: Copyright© 2008-2010 Moritz Lenz

Japanese translation: Copyright© 2011 SATOH Koichi

NAME

"Perl 5 to 6" Lesson 03 - 基本制御構造

SYNOPSIS

if $percent > 100  {
    say "weird mathematics";
}
for 1..3 {
    # $_をループ変数として使う
    say 2 * $_;
}
for 1..3 -> $x {
    # 明示的なループ変数を使う
    say 2 * $x;
}

while $stuff.is_wrong {
    $stuff.try_to_make_right;
}

die "Access denied" unless $password eq "Secret";


DESCRIPTION

ほとんどのPerl5の制御構造はPerl 6でもよく似ています。
一番大きな見た目の変化はif、while、forなどの後にカッコが必要なくなったことです。

正確には、条件をカッコで囲むのは非推奨です。

分岐

ifはほとんど変わっていません。相変わらずelsifやelseの節を付けることができます。
unlessもありますが、else節を付けることができなくなりました。

if $sheep == 0 {
    say "How boring";
} elsif $sheep == 1 {
    say "One lonely sheep";
} else {
    say "A herd, how lovely!";
}


ifやunlessを文修飾子として(つまり文の後に付けて)使うこともできます:

say "you won" if $answer == 42;


ループ

Perl5と同様、nextとlastでループを制御できます。

forループはリストを走査する場合のみに使われるようになりました。
ループ変数が与えられない場合はデフォルトで$_が使われます。

for 1..10 -> $x {
    say $x;
}


-> $x { ... }という部分は「ポインティ・ブロック」と呼ばれ、無名サブルーチン、あるいはLispのlambdaのようなものです。

1つ以上のループ変数を使うこともできます:

for 0..5 -> $even, $odd {
    say "Even: $even \t Odd: $odd";
}


これはハッシュを走査する方法でもあります:

my %h = a => 1, b => 2, c => 3;
for %h.kv -> $key, $value {
    say "$key: $value";
}


Cスタイルのforループはloopという名前になりました(これはカッコを必要とする唯一のループ構造でもあります):

loop (my $x = 1; $x < 100; $x = $x**2) {
    say $x;
}


SEE ALSO

http://perlcabal.org/syn/S04.html#Conditional_statements



Perl 5 to 6 - 型
2011-02-13T11:32:00.006+09:00
2011-02-27: コメント欄で既に改訂された仕様の指摘がありましたので一部補足しました。id:uasiに感謝します。

これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 02 - Typesの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

Original text: Copyright© 2008-2010 Moritz Lenz

Japanese translation: Copyright© 2011 SATOH Koichi

NAME

"Perl 5 to 6" Lesson 02 - 型

SYNOPSIS

my Int $x = 3;
$x = "foo";         # エラー
say $x.WHAT;        # 'Int()'

# 型チェック:
if $x ~~ Int {
    say '$x contains an Int'
}


DESCRIPTION

Perl6には型があります。すべてが何らかの形のオブジェクトであり、型を持ちます。変数は型制約を持つことができますが、必須ではありません。

知っておくべきいくつかの基本的な型があります:

'a string'      # Str
2               # Int
3.14            # Rat (有理数)
(1, 2, 3)       # Seq


「通常の」組み込み型はすべて大文字で始まります。「通常の」型はすべてAnyを継承し、他も含めたすべての型はObjectMu(コメントで指摘があったので修正しました。多謝。ちなみに「無」から来ているそうです)を継承します。

型名を変数宣言に加えることで、変数が保持できる値の型に制約をつけられます。

my Numeric $x = 3.4;
my Int @a = 1, 2, 3;


「間違った」型(与えられた型でもその派生型でもない型)の値を変数に代入しようとするとエラーになります。

配列に対する型宣言はその要素に対して適用されるので、my Str @sは文字列だけを格納できる配列になります。

いくつかの型は更に詳細な型の族を表します。例えば整数、有理数と浮動小数(Num型)はNumeric型を構成します。

イントロスペクション

.WHATメソッドを呼ぶことでインスタンスの型を知ることができます。

say "foo".WHAT;     # Str()


ただし、もしインスタンスが与えられた型を継承しているか確認したいのなら別の方法があります。
継承関係も考慮してくれるのでこちらの方がオススメです:

if $x ~~ Int {
    say 'Variable $x contains an integer';
}


MOTIVATION

型システムの詳細をすべて完全に理解することは簡単ではありませんが、型が必要な理由があります:

安全なプログラミング

インスタンスがある型であると宣言すれば然るべき処理を実行することを確信できます。確認の必要はありません。

最適化可能性

コンパイル時に型情報があれば然るべき最適化を行うことができます。
Perl6は必ずしもCより遅くなりません。原理的には。

拡張性

型情報と多重ディスパッチによって、特定の型に対して演算を簡単に再定義できます。

SEE ALSO

http://perlcabal.org/syn/S02.html#Built-In_Data_Types



Perl 5 to 6 - 文字列、配列、ハッシュ
2011-02-12T00:51:00.010+09:00
これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" Lesson 01 - Strings, Arrays, Hashes;の日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

Original text: Copyright© 2008-2010 Moritz Lenz

Japanese translation: Copyright© 2011 SATOH Koichi

NAME

"Perl 5 to 6" Lesson 01 - 文字列、配列、ハッシュ

SYNOPSIS

my $five = 5;
print "an interpolating string, just like in perl $five\n";
say 'say() adds a newline to the output, just like in perl 5.10';

my @array = 1, 2, 3, 'foo';
my $sum = @array[0] + @array[1];
if $sum > @array[2] {
    say "not executed";
}
my $number_of_elems = @array.elems;     # or +@array
my $last_item = @array[*-1];

my %hash = foo => 1, bar => 2, baz => 3;
say %hash{'bar'};                       # 2
say %hash<bar>;                         # 自動クォートを使った例
# これはエラーになる: %hash{bar}
# (宣言されていないサブルーチンbar()を呼び出そうとする)


DESCRIPTION

Perl6はPerl5と良く似ています――より良いだけです。
文はセミコロンで終端します。ブロックの最後の文と、行の最後の閉じ中カッコの後では省略可能です。

変数は相変わらず($、@、%のような)シジル(Sigil)で始まりますし、多くのPerl5組み込み関数はPerl6でも変更されていません。

文字列

文字列はダブルクォート(変数展開する場合)かシングルクォートで囲みます。バックスラッシュのエスケープはPerl5と同様に作用します。

ただし変数展開の規則は少し変更されました。以下のものは展開されます。

my $scalar = 6;
my @array = 1, 2, 3;
say "Perl $scalar";         # 'Perl 6'
say "An @array[]";          # 'An 1 2 3', 禅スライス(Zen slice)とも呼ばれる
say "@array[1]";            # '2'
say "Code: { $scalar * 2 }" # 'Code: 12'


配列とハッシュは添字(あるいはカッコが付いた"some $obj.method()"のような関数呼び出し)が付いた場合のみ展開されます。空の添字はデータ構造全体を展開します。

中カッコの中のブロックはコードとして実行され、結果が文字列中に展開されます。

配列

配列変数は相変わらず@シジルで始まります。
格納された要素にアクセスするとき、例えば添字が1つ与えられた場合であってもそのままです。

my @a = 5, 1, 2;            # カッコは必要なくなりました
say @a[0];                  # そう、@で始まるんです
say @a[0, 2];               # スライスも使えます


リストはカンマ演算子で生成されます。1,はリストですが、(1)は違います。

何もかもがオブジェクトなので、配列に対してメソッド呼び出しができます:

my @b = @a.sort;
@b.elems;                   # 要素数
if @b > 2 { say "yes" }     # まだ動く
@b.end                      # 末尾要素のインデックス。$#arrayの代替
my @c = @b.map({$_ * 2 });  # mapはメソッドにもあります


従来のqw(...)クォート生成の略記法があります:

my @methods = <shift unshift push pop end delete sort map>;


ハッシュ

Perl5のハッシュはリストコンテキストでは偶数サイズのリストでしたが、Perl6のハッシュはペアのリストです。
ペアはサブルーチンの名前付き引数のような他の使い道もありますが、それについてはもっと後で出てきます。

配列同様シジルは添字を指定したときも変わりませんし、ハッシュに対して呼び出せるメソッドもあります。

my %drinks =
    France  => 'Wine',
    Bavaria => 'Beer',
    USA     => 'Coke';

say "The people in France love ",  %drinks{'France'};
my @countries = %drinks.keys.sort;


%hash{...}でハッシュの要素にアクセスするとき、キーがPerl5のように自動でクォートされない点に注意して下さい。
%hash{foo}は添字"foo"にアクセスせず、関数foo()を呼び出します。
自動クォートはなくなったわけではなく、構文が変更されました:

say %drinks<Bavaria>;


おわりに

ほとんどの組み込み関数はメソッドとサブルーチンの両方があるので、sort @arrayとも@array.sortとも書くことができます。

最後に[...]と{...}(項の直後に出てくるもの)は特別な構文のメソッド呼び出しに過ぎず、配列やハッシュに結びついてはいないことを覚えておいて下さい。つまりこれらは、特定のシジルにも結びついていないということです。

my $a = [1, 2, 3];
say $a[2];          # 3


これはつまり、デリファレンスのための特別な構文が必要ないということ、また配列やハッシュ、サブルーチンとして同時にふるまうようなオブジェクトが作れるということです。

SEE ALSO

http://perlcabal.org/syn/S02.html, http://perlcabal.org/syn/S29.html



Perl 5 to 6 - イントロダクション
2011-02-11T23:34:00.013+09:00
これはMoritz Lenz氏のWebサイトPerlgeek.deで公開されているブログ記事"Perl 5 to 6" - Introductionの日本語訳です。

原文はCreative Commons Attribution 3.0 Germanyに基づいて公開されています。

本エントリにはCreative Commons Attribution 3.0 Unportedを適用します。

Original text: Copyright© 2008-2010 Moritz Lenz

Japanese translation: Copyright© 2011 SATOH Koichi

NAME

"Perl 5 to 6" - イントロダクション

SYNOPSIS

Perl6を学ぶ (もし既にPerl5を知っているなら)
Perl6の愛で方を学ぶ
理由を知る


DESCRIPTION

Perl6は十分にドキュメント化されていません。(仕様書を別にすれば)コンパイラを書くことの方がユーザ向けのドキュメントを用意することより急を要すると思われていることを鑑みれば、これは驚くべきことではありません。

残念なことですが、つまりこれはPerl6を学ぶことが容易とは言えないということで、仕様書やらIRCやらテストスイートからPerl6を学ぼうとする動機を見つけるくらいの強い関心がないと駄目だということです。

筆者が"Perl 5 to 6"(良い名前がない)と呼ぶことにしたこのプロジェクトは、短い記事の連載でこのギャップを埋めることを目的にしています。

それぞれのレッスンはかなりテーマを絞り、短い例を使って2、3の最も重要な点を説明しようと思います。また、何故Perl5と6で物事が変わったのか、何故それが重要なのかも説明します。レッスンを読めば、Synopsis(Perl6の英知すべての規範的なソースです)を基本的に理解するのに十分な知識が得られるようにしたいと思います。

読み易さを維持するために、各レッスンは200行ないし1000語(訳注:原文基準)を越えないものとします(ただしこれは緩い制限です)。

恐らくレッスンはプログラミング言語を学ぶには短過ぎるでしょうが、言語設計の輪郭を描き出し、言語を学ばずともその美しさが感じられるようにしたいと思います。

IT'S NOT

これはPerl5プログラムのPerl6移行ガイドではありません。差異の包括的なリストでもありません。もしそのようなものを探しているなら、Perl6::Perl5::Differencesを見て下さい。

また現在の実装ではなく、仕様上の言語向けに書いています。

ROADMAP

既に書かれたか、準備中のもの:


イントロダクション
文字列、配列、ハッシュ
型
制御構造
サブルーチンとシグネチャ
オブジェクトとクラス
コンテキスト
ルール(正規表現)
ジャンクション
比較とスマートマッチ
コンテナとバインディング
基本的な演算
遅延性 (-)
カスタム演算子 (-)
MAINサブルーチン
ツイジル(Twigils)
列挙
Unicode (-)
スコープ
もっと正規表現
XML用の正規表現
サブセット型
実装の現状
クォートと構文解析 (-)
縮約メタ演算子
交差メタ演算子
例外と制御例外


(Rakudoにほとんど、あるいは全く実装されていない機能には(-)が付いています)

書きたいと思っているが、筆者がまた十分に理解できていないこと:


マクロ
メタオブジェクトプログラミング
並列性
IO


言及したいと思っているが、どこに入れるべきか迷っているもの:


.perlメソッド


これらのレッスンが時代遅れにならないよう、時々更新していくつもりです。
(訳注: 翻訳もできるだけ追随しようと思います。更新されてなかったらコメントなどで連絡をば)

AUTHOR

Moritz Lenz, http://perlgeek.de/, moritz@faui2k3.org

LINKS

他のドキュメントがhttp://perl6.org/documentation/で公開されています。



Perl - -CスイッチでPerlIOレイヤを操作
2009-07-16T21:13:00.006+09:00
要約

マルチバイト文字を扱うワンライナはとりあえず-CSDとでもしておくと安心。

長文

どう書く？orgでバイナリクロックのお題に解答したら、あの小飼弾氏がさらに短くして下さいました。うはー!


perl -CIO -Mutf8 -le 'print for map { $_ = sprintf "%06b", $_; tr/01/□■/; $_ } (localtime)[2,1];'



Perl5.8対応(そうか、-lで$\出力だった)はともかく-Cスイッチって何ぞや、と思ったのでperldoc perlrun：


−C [number/list]
     The "−C" flag controls some of the Perl Unicode features.


「Perl5.8.1より前はWin32のワイド版APIを使うためのスイッチだったけど、誰も使わなかったから使い回すことにしたよ」とか中々楽しいことが書いてあり、現在はPerlIOレイヤを操作するスイッチになっているそうです。

以下簡単な説明。

-C(I|O|E|S)

-C(I|O|E)はそれぞれ標準(入力|出力|エラー出力)のPerlIOレイヤをUTF-8に設定するオプションです。つまり次のコードと等価になります：

 binmode STDIN, ':utf8';  # -CI
 binmode STDOUT, ':utf8'; # -CO
 binmode STDERR, ':utf8'; # -CE


また-CSオプションで、これらをまとめて指定できます。

-C(i|o|D)

-C(i|o)はそれぞれ読み出し(<)、書き込み(>)用に開くファイルハンドルに適用されるデフォルトのPerlIOレイヤをUTF-8に指定します。-CDは両者の一括指定。それぞれopenプラグマを使った以下のコードと等価です：

 use open IN => ':utf8';  # -Ci
 use open OUT => ':utf8'; # -Co
 use open IO => ':utf8';  # -CD


-CA

@ARGVの内容にUTF-8フラグを立てます。コマンドライン引数でUnicode文字列を渡す場合(あるか？)に。

-CL

ロケールに関する環境変数LC_ALL、LC_TYPE、LANGをこの順に見ていき、存在する最初の値が"UTF-8"であったときのみ-Cオプションの指定を有効にします。

例えば-CSDALとすると、ロケールがUTF-8であった場合のみ-CSDAが有効になります。

-Ca

${^UTF8CACHE}を-1に設定します……よく分かりません。デバッグ用のオプションのようです。

"to run the UTF−8 caching code in debugging mode."とあるので、perl -dのデバッグ・セッション中でもUnicode文字列のキャッシングを有効にするとかそんな意味でしょうか。



Project Euler - Problem 43
2009-07-12T22:15:00.000+09:00
問題


原文


  Let d₁ be the 1^st digit, d₂ be the 2^nd digit, and so on. In this way, we note the following:
  
  
  d₂d₃d₄=406 is divisible by 2
  d₃d₄d₅=063 is divisible by 3
  d₄d₅d₆=635 is divisible by 5
  d₅d₆d₇=357 is divisible by 7
  d₆d₇d₈=572 is divisible by 11
  d₇d₈d₉=728 is divisible by 13
  d₈d₉d₁₀=289 is divisible by 17
  
  
  Find the sum of all 0 to 9 pandigital numbers with this property.

日本語訳


  d₁を1桁目, d₂を2桁目の数とし, 以下順にd_nを定義する. この記法を用いると次のことが分かる.
  
  
  d₂d₃d₄=406は2で割り切れる
  d₃d₄d₅=063は3で割り切れる
  d₄d₅d₆=635は5で割り切れる
  d₅d₆d₇=357は7で割り切れる
  d₆d₇d₈=572は11で割り切れる
  d₇d₈d₉=728は13で割り切れる
  d₈d₉d₁₀=289は17で割り切れる
  
  
  このような性質をもつ0から9のPandigital数の総和を求めよ.



解答

Problem 41と同様にPandigital数を作るだけです。途中で枝切りして無駄な計算を省いています。

除数を保持する配列は一応定数にしてみました。定数の宣言には標準プラグマにconstantがありますが、コードが分かり易いAttribute::ConstantというCPANモジュールを使っています。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use Attribute::Constant;
use List::Util qw/sum/;
use Set::Object qw/set/;

my @divisors : Constant(2, 3, 5, 7, 11, 13, 17);
sub solutions(;$$);
sub solutions(;$$) {
  my ($num, $rest_digits) = @_;
  $num //= '';
  $rest_digits //= set(0 .. 9);
  my $len = length $num;
  return () if $len >= 4 and substr($num, -3, 3) % $divisors[$len - 4] != 0;
  return () if $num =~ /^0/;
  return ('') if $rest_digits->is_null;

  my @solutions;
  for my $n ($rest_digits->members) {
    $rest_digits->remove($n);
    push @solutions, map { $n . $_ } solutions($num . $n, $rest_digits);
    $rest_digits->insert($n);
  }
  return @solutions;
}

say sum solutions;



Project Euler - Problem 42
2009-07-06T22:41:00.000+09:00
問題


原文


  By converting each letter in a word to a number corresponding to its alphabetical position and adding these values we form a word value. For example, the word value for SKY is 19 + 11 + 25 = 55 = t₁₀. If the word value is a triangle number then we shall call the word a triangle word.
  
  Using words.txt (right click and 'Save Link/Target As...'), a 16K text file containing nearly two-thousand common English words, how many are triangle words?

日本語訳


  単語中のアルファベットを数値に変換した後に和をとる. この和を「単語の値」と呼ぶことにする. 例えば SKY は 19 + 11 + 25 = 55 = t₁₀である. 単語の値が三角数であるとき, その単語を三角語と呼ぶ.
  
  16Kのテキストファイルword.txt中に約2000語の英単語が記されている. 三角語はいくつあるか?



解答

42問目!

ちょっと拍子抜けするほど簡単です。三角数を片っ端から計算して連想配列に入れておき、文字列の値を計算して照合するだけです。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;

sub word_value($) {
  my $offset = ord('A') - 1;
  sum map { ord($_) - $offset } split //, uc shift;
}

sub tri_num($) {
  my $n = shift;
  $n * ($n + 1) / 2;
}

open my $words, '<', 'words.txt' or die $!;
my @words = map { /\"(\w+)\"/ } split /,/, do { local $/ = undef; <$words> };

my $n = 0;
my $curr_max = tri_num $n++;
my %tri_nums = ($curr_max => 1);
say 0 + grep {
  my $word_val = word_value $_;
  $tri_nums{$curr_max = tri_num $n++} = 1 while $curr_max < $word_val;
  $tri_nums{$word_val};
} @words;



Project Euler - Problem 41
2009-07-06T03:00:00.003+09:00
問題


原文


  What is the largest n-digit pandigital prime that exists?

日本語訳


  n桁のPandigitalな素数の中で最大の数を答えよ.



解答

ある数が3の倍数のとき、その各桁を足し合わせた数もまた3の倍数であり、その逆もいえます：

n = a_m-1a_m-2...a₀

= a_m-1×10^m-1 + a_m-2×10^m-2 + ... + a₀×10⁰

= a_m-1×(1 + 999...9) + a_m-2×(1 + 99...9) + ... + a₁×(1 + 9) + a₀×1

= (a_m-1 + a_m-2 + ... + a₀) + a_m-1×(999...9) + a_m-2×(99...9) + ... + a₁×9

∴ nが3の倍数のとき、a_m-1 + a_m-2 + ... + a₀は3の倍数

つまり1 + 2 + ... + mが3の倍数であったとすると、m桁のPandigital数の中に解は存在し得ないことが分かります。m = 8, 9のときがこの場合に該当するので、探索範囲を大きく減らせます。

Pandigital数を作る際に数値を重複なく選ぶため、Set::ObjectというCPANモジュールを使って簡単な集合演算を行っています。

#!/usr/bin/env perl;

use strict;
use warnings;
use feature qw/say state/;
use List::Util qw/sum/;
use List::MoreUtils qw/none/;
use Set::Object qw/set/;

sub is_prime($) {
  state %memos;
  my $n = shift;
  return 0 if $n < 2;
  return 1 if $n == 2;
  return 1 if $n == 3;
  return $memos{$n} if exists $memos{$n};
  $memos{$n} = none { $n % $_ == 0 } 2 .. sqrt $n;
}

my $prime_tails = set(1, 3, 7, 9);

sub max_pandigital_prime($;$$);
sub max_pandigital_prime($;$$) {
  my ($ndigits, $num, $rest_digits) = @_;
  $num //= '';
  $rest_digits //= set(1 .. $ndigits);

  return is_prime $num ? $num : undef if $rest_digits->is_null;
  return undef if ($rest_digits * $prime_tails)->is_null;

  for my $n (sort { $b <=> $a } $rest_digits->members) {
    $rest_digits->remove($n);
    my $answer = max_pandigital_prime($ndigits - 1, $num . $n, $rest_digits);
    return $answer if defined $answer;
    $rest_digits->insert($n);
  }
  return undef;
}

my $answer;
for my $ndigits (reverse 1 .. 9) {
  next if sum(1 .. $ndigits) % 3 == 0;
  last if defined ($answer = max_pandigital_prime($ndigits));
}
say $answer;



Project Euler - Problem 40
2009-07-02T23:26:00.001+09:00
問題


原文


  An irrational decimal fraction is created by concatenating the positive integers:
  
  0.123456789101112131415161718192021...
  
  It can be seen that the 12^th digit of the fractional part is 1.
  
  If d_n represents the n^th digit of the fractional part, find the value of the following expression.
  
  d₁ × d₁₀ × d₁₀₀ × d₁₀₀₀ × d₁₀₀₀₀ × d₁₀₀₀₀₀ × d_1000000

日本語訳


  正の整数を順に連結して得られる以下の10進の無理数を考える:
  
  0.123456789101112131415161718192021...
  
  小数点第12位は1である.
  
  d_nで小数点第n位の数を表す. d₁ × d₁₀ × d₁₀₀ × d₁₀₀₀ × d₁₀₀₀₀ × d₁₀₀₀₀₀ × d_1000000 を求めよ.



解答

数列作って、繋げて、取り出して、掛け合わせる。おしまい。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/reduce/;

my $n = 0;
my $str = '';
$str .= $n++ while length $str <= 1_000_000;

our ($a, $b);
say reduce { $a * $b } map { substr $str, 10 ** $_, 1 } 0 .. 6;



Project Euler - Problem 39
2009-07-02T13:31:00.002+09:00
問題


原文


  If p is the perimeter of a right angle triangle with integral length sides, {a,b,c}, there are exactly three solutions for p = 120.
  
  {20,48,52}, {24,45,51}, {30,40,50}
  
  For which value of p ≤ 1000, is the number of solutions maximised?

日本語訳


  辺の長さが{a,b,c}と整数の3つ組である直角三角形を考え, その周囲の長さをpとする. p = 120のときには3つの解が存在する:
  
  {20,48,52}, {24,45,51}, {30,40,50}
  
  p < 1000 で解の数が最大になる p を求めよ.



解答

問題の前提からp = a + b + cです。

三平方の定理よりa² + b² = c²で、p = a + b + c ⇒ c = p - (a + b)なので、cを消去して：

a² + b² = (p - (a + b))² = p² - 2p(a + b) + a² + 2ab + b²

よってp² - 2p(a + b) + 2ab = 0であり、a、bが解のときpは偶数であることが分かります。
またこれをbについて解くとb = (2ap - p²) / 2(a - p)なので、aの値を定めればbの値は一意に決まることが分かります。
結局各pについてa > bとなるまでaを一通り試すだけで良いことになります。

実のところ答えの3つ組を計算する必要はなかったりしますが、答えを出力した上でその数を数える形にしています。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/reduce/;

sub solutions($) {
  my $p = shift;
  return () unless $p % 2 == 0;

  my @solutions;
  for my $i (1 .. $p - 1) {
    my $j = ($p * (2 * $i - $p)) / (2 * ($i - $p));
    last unless $i <= $j;
    push @solutions, [ $i, $j, sqrt($i ** 2 + $j ** 2) ] if $j == int $j;
  }
  return @solutions;
}

say map { $_->{p} } reduce {
  $a->{num_sols} > $b->{num_sols} ? $a : $b
} map { { p => $_, num_sols => 0 + grep 1, solutions $_ } } 1 .. 999;



Project Euler - Problem 38
2009-06-27T19:59:00.004+09:00
問題


原文


  What is the largest 1 to 9 pandigital 9-digit number that can be formed as the concatenated product of an integer with (1,2, ... , n) where n > 1?

日本語訳


  整数と(1,2,...,n) (n > 1) との連結積として得られる9桁のPandigital数の中で最大のものを答えよ.



解答

乗数が1, 2, ..., n (n > 1)で桁数は9なので、被乗数mは1から9999の範囲です。
範囲が分かれば後は簡単で、m×1から順に積を連結していって、丁度9桁となったときにPandigital数であればいいわけです。
Pandigital数を定義通り考えれば「1から9のすべての数字が1回以上現れる数」ですが、この問題では桁数の制約からいずれの数字も1回ずつしか現れないため、「同じ数字が重複して出現せず、0が現れない数」に読み替えることができます。Perlだとこちらの方が正規表現マッチングが高速でした。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/max/;

say max map {
  my $cat = '';
  for (my $mul = 1; length $cat < 9; $cat .= $_ * $mul++) {}
  (length $cat == 9 and $cat !~ /0/ and $cat !~ /(\d).*\1/) ? $cat : ()
} 1 .. 9999;



Project Euler - Problem 37
2009-06-27T02:40:00.002+09:00
問題


原文


  Find the sum of the only eleven primes that are both truncatable from left to right and right to left.

日本語訳


  右から切り詰めても左から切り詰めても素数になるような素数は11個しかない. 総和を求めよ.



解答

考え方はProblem 35と同じで、切り詰めていくと途中で合成数になることが分かっている数を最初に除外しています。
0、4、6、8のいずれかの数字を含む場合は明らかに途中で偶数になりますが、2と5は少し特別で、数の一番上の桁にのみ現れた場合は除外できません。何故なら：


左から切り詰めたときは最初に取り除かれるので関係がない。
右から切り詰めていって最後の1桁になったとき、2と5は素数である。


からです。具体的には23と53がこのケースに該当するので、間違って除外すると処理が終わりません。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say state/;
use List::Util qw/sum/;
use List::MoreUtils qw/all none/;

sub is_prime($) {
  state %memos;
  my $n = shift;
  return 0 if $n < 2;
  return 1 if $n == 2;
  return 1 if $n == 3;
  return $memos{$n} if exists $memos{$n};
  $memos{$n} = none { $n % $_ == 0 } 2 .. sqrt $n;
}

sub is_truncatable_prime($) {
  my $n = shift;
  return 0 if length $n == 1;
  return 0 if $n =~ /[0468]/;
  return 0 if $n =~ /.[25]/;
  return 0 unless is_prime $n;
  all {
    is_prime substr($n, $_) and is_prime substr($n, 0, -$_)
  } 1 .. length($n) - 1;
}

my @truncatables;
for (my $i = 11; @truncatables != 11; $i += 2) {
  push @truncatables, $i if is_truncatable_prime $i;
}
say sum @truncatables;



Project Euler - Problem 36
2009-06-24T00:35:00.004+09:00
問題


原文


  Find the sum of all numbers, less than one million, which are palindromic in base 10 and base 2.

日本語訳


  100万未満で10進でも2進でも回文数になるような数の総和を求めよ.



解答

nで割り切れる数はn進法で表すと下の桁が0になります(e.g. 100₁₀、32=20₁₆、8=1000₂)。
このような数は反転させると(先頭の0は無視するので)桁数が変わってしまうため、回文数になりません。よってこのような数は最初に除外できます。

この問題の場合、2か10で割り切れる数は解にならないことが分かります。10で割り切れるときは当然2でも割り切れるので、実際には2で割り切れるか調べれば十分です。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;

sub is_palindromic($) {
  my $n = shift;
  $n eq reverse $n;
}

say sum grep {
  is_palindromic $_ and is_palindromic sprintf '%b', $_;
} grep { $_ % 2 != 0 } 1 .. 1_000_000;


追記

値の範囲ですが、1,000,000まで探索する必要はありませんでした。
1から999まで探索して、それを反転させた数値と連結すれば偶数桁の回文数、その間に1つ数字を入れれば奇数桁の回文数が得られるので、探索範囲を絞った上に10進数の回文数判定も省けます。

少し長いですが、70倍ほど高速化できました。

use Scalar::Util qw/looks_like_number/;
say sum grep {
  $_ <= 1_000_000 and is_palindromic sprintf '%b', $_;
} map {
  my $half = $_;
  map {
    $half . $_ . reverse($half)
  } (looks_like_number $half) ? ('', ($half > 100) ? () : 0 .. 9) : 0 .. 9;
} grep {
  not looks_like_number $_ or /^[13579]/;
} ('', 1 .. 999);



Project Euler - Problem 35
2009-06-24T00:02:00.003+09:00
問題


原文


  How many circular primes are there below one million?

日本語訳


  100万未満の巡回素数は何個か?



解答

回転させた数値がすべて素数ということは、すべての桁が奇数でなければいけません(ただし2を除く)。

追記

匿名氏にコメントでご指摘頂いたのでコードを一部修正しました。
いずれかの桁に5がある場合も、回転させると必ず5の倍数が現れるので除外できます。

もっと追記

前の修正に間違いが入っているのをご指摘頂いたので修正しました。
5自体は素数なので、巻き添えで除外してはいけません。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say state/;
use List::MoreUtils qw/all none/;

sub is_prime($) {
  state %memos;
  my $n = shift;
  return 0 if $n < 2;
  return 1 if $n == 2;
  return 1 if $n == 3;
  return $memos{$n} if exists $memos{$n};
  $memos{$n} = none { $n % $_ == 0 } 2 .. sqrt $n;
}

sub rotate($) {
  my $n = shift;
  substr($n, 1) . substr($n, 0, 1);
}

sub rotations($) {
  my $n = shift;
  my %seen = ($n => 1);
  $seen{$n} = 1 until exists $seen{$n = rotate $n};
  keys %seen;
}

sub is_circular_prime($) {
  state %memos;
  my $n = shift;
  return 0 if $n =~ /[024568]/ and $n != 2 and $n != 5;
  return $memos{$n} if exists $memos{$n};

  my @rotations = rotations $n;
  my $is_circular_prime = all { is_prime $_ } @rotations;
  (@memos{@rotations} = ($is_circular_prime) x @rotations)[0];
}

say 0 + grep { is_circular_prime $_ } 1 .. 1_000_000;



Project Euler - Problem 34
2009-06-21T23:11:00.000+09:00
問題


原文


  Find the sum of all numbers which are equal to the sum of the factorial of their digits.

日本語訳


  各桁の数の階乗の和が自分自身と一致するような数の総和を求めよ.



解答

Problem 30とほぼ同じ問題なので、その時の解答を基にして考えます。

前回の問題と違うのは、0! = 1なので0を含む数字を含まない数字と同一視できない点です。
そこで正規化の際に0を省くのをやめて、例えば251と2501はそれぞれ125と0125として別に扱うことにします。

また0! = 1!なので、例えば110と100のように各桁の階乗の和が同じになる数が存在し、これを重複して数えないようにしなければなりません。
既に数えた値を連想配列で覚えておいてもいいのですが、List::MoreUtilsのuniq関数で重複要素を前もって削除する方が高速でした。

#!/usr/bin/env perl;

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum reduce/;
use List::MoreUtils qw/uniq/;

sub factorial($) {
  our ($a, $b);
  my $n = shift;
  return 1 if $n == 0;
  return reduce { $a * $b } 1 .. $n;
}

my @facts = map { factorial $_ } 0 .. 9;
my $max_digits;
for ($max_digits = 1;
     10 ** $max_digits <= $max_digits * $facts[9];
     $max_digits++) {}

my @sum_dicts = ({}, { map { ($_ => $facts[$_]) } 0 .. 9 });
until ($#sum_dicts == $max_digits) {
  push @sum_dicts, { map {
    my $prev_key = $_;
    my $last_digit = substr $prev_key, -1, 1;
    map {
      ("$prev_key$_" => $sum_dicts[-1]{$prev_key} + $facts[$_])
    } $last_digit .. 9;
  } keys %{ $sum_dicts[-1] } };
}

say sum grep {
  my $sorted = join '', sort split //;
  $_ == $sum_dicts[length $sorted]{$sorted} and $_ != 1 and $_ != 2;
} uniq map { values %$_ } @sum_dicts;



Project Euler - Problem 33
2009-06-15T00:19:00.000+09:00
問題


原文


  The fraction 49/98 is a curious fraction, as an inexperienced mathematician in attempting to simplify it may incorrectly believe that 49/98 = 4/8, which is correct, is obtained by cancelling the 9s.
  
  We shall consider fractions like, 30/50 = 3/5, to be trivial examples.
  
  There are exactly four non-trivial examples of this type of fraction, less than one in value, and containing two digits in the numerator and denominator.
  
  If the product of these four fractions is given in its lowest common terms, find the value of the denominator.

日本語訳


  49/98は面白い分数である. 「分子・分母の9をキャンセルしたので 49/98 = 4/8 が得られた」と経験を積んでいない数学者が誤って思い込んでしまうかもしれないからである.
  
  我々は 30/50 = 3/5 のようなタイプは自明な例だとする.
  
  1より小さく分子・分母がともに2桁の数になるような自明でない分数は 4個ある.
  
  その4個の分数の積が約分された形で与えられたとき, 分母の値を答えよ.



解答

どうも「自明でない分数」の基準がよく分かりませんが、「分子・分母に共通する数字を取り除いたとき、元の分数と同じ値になるような分数(ただし分子・分母が10の倍数である場合を除く)」みたいです。

分数を(numerator, denominator)というリストの形で扱うことにして、「共通する数字を取り除いた1桁/1桁の分数で、通分した結果が元の分数のそれと等しい」という長ったらしい述語is_non_trivialを作りました。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/reduce/;
use List::MoreUtils qw/none/;

sub gcd {
  my ($m, $n) = @_;
  ($m, $n) = ($n, $m) if $m < $n;
  my $r = $m % $n;
  $r == 0 ? $n : gcd($n, $r);
}

sub reduce_fraction {
  my ($num, $den) = @_;
  my $gcd = gcd($num, $den);
  map { $_ / $gcd } ($num, $den);
}

sub is_non_trivial {
  my ($num, $den) = @_;
  return 0 if $num % 10 == 0 or $den % 10 == 0;

  my @ns = split //, $num;
  my @ds = split //, $den;
  my @uns = grep { my $n = $_; none { $_ == $n } @ds } @ns;
  my @uds = grep { my $d = $_; none { $_ == $d } @ns } @ds;
  return 0 unless @uns == 1 and @uds == 1;

  my ($rn, $rd) = reduce_fraction($num, $den);
  my ($urn, $urd) = reduce_fraction(@uns, @uds);
  $rn == $urn and $rd == $urd;
}

my @product = @{
  reduce {
    [ $a->[0] * $b->[0], $a->[1] * $b->[1] ]
  } map {
    my $den = $_;
    map { [$_, $den] } grep { is_non_trivial($_, $den) } 10 .. $den - 1;
  } 11 .. 99
};
say +(reduce_fraction(@product))[1];



Project Euler - Problem 32
2009-06-13T20:41:00.001+09:00
問題


原文


  Find the sum of all products whose multiplicand/multiplier/product identity can be written as a 1 through 9 pandigital.

日本語訳


  掛けられる数/掛ける数/積に1から9の数が1回ずつ出現するような積の総和を求めよ.



解答

n桁×m桁の数の積はn+m-1桁かn+m桁になる(e.g. 10×10=100, 99×99=9,801)ので、桁数の合計が9になるとき、積の桁数は4桁であることが分かります。つまり、調べる積の範囲は1,000から9,999までとなります。

あとは数字が重複していないかどうかの判定ですが、積・乗数・被乗数を並べて数字列を作り、小さい順に並べ替えて123456789になれば重複していないことになります。
例えば4396=28×157の場合、並べて書くと439628157という数字列ができます。これを並べ替えると123456789になりますから、4396は答えの1つであることが分かります。

乗数の取り得る範囲は1から積の平方根の間ですが、1の時は積と被乗数が同じになるので明らかに答えではありません。従って2から開始すると少しだけ早くなります。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;
use List::MoreUtils qw/any/;

say sum grep {
  my $n = $_;
  any {
    join('', sort split //, $n . $_ . $n / $_) eq '123456789';
  } grep { $n % $_ == 0 } 2 .. sqrt $n;
} 1000 .. 9999;



Project Euler - Problem 31
2009-05-14T13:14:00.000+09:00
問題


原文


  How many different ways can £2 be made using any number of coins?

日本語訳


  いくらかの硬貨を使って2ポンドを作る方法はいくつあるでしょうか?



解答

ポンドとペンスを別々に扱うのは面倒と無駄以外の何者でもないので、単位をペンスに統一します。よって問題は合計が200ペンスとなるコインの組み合わせは何通りあるかです。

コインを昇順にC_i(i = 0, 1, 2, ..., 7)と番号づけることにします。
合計nペンスとなるC_k以下のコインを使った組み合わせをcc(n, k)と表すと、次のようになります：


cc(0, k) = 1
cc(n, 1) = 1
cc(n, k) = Σ(cc(n - iC_k, k - 1))、ただしi ∈ { 0 , 1, 2, ..., floor(n / C_k) }


副問題は同じものが何度も出てくるのでメモ化しています。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say state/;
use List::Util qw/sum/;

sub coin_comb($;$);
{
  my @coins = (1, 2, 5, 10, 20, 50, 100, 200);
  sub coin_comb($;$) {
    state %memos;
    my ($currency, $coin_idx) = @_;
    $coin_idx //= $#coins;

    return $memos{$currency, $coin_idx} if exists $memos{$currency, $coin_idx};
    return 1 if $currency == 0;
    return 1 if $coin_idx == 0;

    use integer;
    $memos{$currency, $coin_idx} = sum map {
      coin_comb($currency - $coins[$coin_idx] * $_, $coin_idx - 1);
    } 0 .. $currency / $coins[$coin_idx];
  }
}
say coin_comb 200;



Project Euler - Problem 30
2009-05-14T11:48:00.001+09:00
問題


原文


  Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.

日本語訳


  各桁を5乗した和が元の数と一致するような数の総和を求めよ.



解答

まず探索範囲の上限を定める必要があります。n桁の最大の整数a_n = 9_n-19_n-2...9₀を考えると、その各桁の5乗の和はb_n = 9⁵nと表せます。


a_n+1 = 10a_n + 9
b_n+1 = b_n + 9⁵


ですから、桁数nが大きくなるにつれてaがbよりも急激に大きくなるのが分かります。ある桁数n_maxを超えると、常にa_{n_max} > b_{n_max}が成立するので、両者が等しくなることはなくなります。
実際に調べるとn_maxは6なので、探索範囲は高々0から999,999までとなります。

各桁の乗数の和は、桁の並びに関わらず各桁の数のみによって決まります。例えば2501、5012、(0)215のいずれも同じb_nを持つので、これを別々に計算するのは時間の無駄です。
そこで、このような数をすべて同値と見なす正規化を考えます。手っ取り早く桁の並べ替えで良いでしょう。各桁を昇順に並べ替え、その上で先頭に1個以上0があったら取り除くという処理です。先ほどの例に挙げた数字をこの方法で正規化すると、いずれも125となります。

この正規化された数のみを走査すれば良いわけですから、（0を含まない）n桁の数1つにつき同じ値をn!通り計算していたところが、1通りで済むことになります。

処理の手順をまとめると次のようになります：


全ての正規化された数に対してb_nを計算し、連想配列に格納しておく。
連想配列に格納された値を1つ取り出し、a_nとする。
a_nを正規化して連想配列から対応するb_nを引く。
a_n = b_nであれば解に加える。
連想配列の値を全て走査するまで2.に戻って繰り返す。


下記のコードでは初期化の都合上、桁数ごとに連想配列を分けていますがアルゴリズム自体に違いはありません。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;

sub regularize($) {
  join '', grep { $_ != 0 } sort { $a <=> $b } split //, shift;
}

my $max_digits = 0;
my ($upper_limit, $sum);
do {
  $max_digits++;
  $upper_limit = 9 x $max_digits;
  $sum = $max_digits * (9 ** 5);
} while $upper_limit < $sum;

my @powers = map { $_ ** 5 } 0 .. 9;
my @sum_dicts = ({ '' => 0 }, { map { ($_ => $powers[$_]) } 1 .. 9 });
while ($#sum_dicts < $max_digits) {
  push @sum_dicts, { map {
    my $prev_key = $_;
    my $last_digit = substr $prev_key, -1, 1;
    map {
      ("$prev_key$_" => $sum_dicts[-1]{$prev_key} + $powers[$_])
    } $last_digit .. 9;
  } keys %{ $sum_dicts[-1] } };
}
say sum grep {
  my $sorted = regularize $_;
  $_ == $sum_dicts[length $sorted]{$sorted};
} grep { $_ > 1 } map { values %$_ } @sum_dicts ;



Project Euler - Problem 29
2009-05-04T22:24:00.010+09:00
こんばんはSekia the Liarです。更新頻度についての釈明はさておきえーとP.E. 29でしたね。はい、すいません。

問題


原文


  Consider all integer combinations of a^(b) for 2 ≤ a ≤ 5 and 2 ≤ b ≤ 5:
  （引用者による省略）
  How many distinct terms are in the sequence generated by a^b for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?

日本語訳


  2 ≤ a ≤ 5 と 2 ≤ b ≤ 5について, abを全て考えてみよう:
  （引用者による省略）
  2 ≤ a ≤ 100, 2 ≤ b ≤ 100 で同じことをしたときいくつの異なる項が存在するか?



解答

値の重複を取り除くにはハッシュを使うのが定石です。

use strict;
use warnings;
use feature qw/say/;
use Math::BigInt;

my %pows;
for my $n (2 .. 100) {
  for my $i (2 .. 100) {
    $pows{ Math::BigInt->new($n) ** $i } = 1;
  }
}
say scalar keys %pows;


しかしPerlのメソッド解決オーバヘッドは結構でかいので、10,000個のMath::BigIntインスタンス生成は割と時間を食います。毎回Math::BigIntというのも芸がないし、少し頭を使って解いてみることにしました。

a^b = (aⁿ)^b/nであることに着目しましょう。これは中学だか高校だかで習った通りです。ただし問題の範囲は整数なので、指数は2 ≤ b/n ≤ 100なる整数でなければなりません。つまりnはbの約数（ただしb自身を除く）です。

この等号で結ばれたべき乗は同じ（つまり重複した）値を持ちます。

例えば2¹² = 4(=2²)⁶ = 8(=2³)⁴ = 16(=2⁴)³ = 64(=2⁶)² = 4,096であり、他に4,096となるようなべき乗は整数の範囲ではなさそうです（証明してないので間違ってたら教えてください）。

これをふまえると、等式が成り立つa、bの組のうちaが最小のもの（ここでa₀、b₀とおきましょう）が分かれば、残りのものはすべてa = a₀ⁿ、b = b₀/nの形をしているはずです。したがって同じ値を持つa、bの組はすべてa₀、b₀から求められます。

よってa₀、b₀のみを数えて、残りは重複として印をつけてスキップするようにすれば、重複のないべき乗の個数を数えることができます。

ところで2 ≤ aⁿ ≤ 100、2 ≤ b/n ≤ 100という拘束条件にちょっとした注意が必要です。というのも、n = 1のときにこの条件を満足せず、nがある程度大きくなれば満足するa、bが存在するからです。
このような数を取りこぼさないためにはb/n ≤ 100 × floor(log_n100)（floorは床関数）までを探索し、b/n ≤ 100である間はnに1加えて何もせずスキップする、というような処理が必要になります。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use POSIX qw/floor/;

{
  my %memos;
  #returns divisors of $n (except $n itself) in numeric order
  sub divisors($) {
    my $n = shift;
    return @{ $memos{$n} } if exists $memos{$n};

    my @early = grep { $n % $_ == 0 } 2 .. floor sqrt $n;
    my @later = reverse map { $n / $_ } @early;
    shift @later if @later != 0 and $later[0] ** 2 == $n;

    return @{ $memos{$n} = [1, @early, @later] };
  }
}

sub logn($$) { my ($b, $n) = @_; (log $n) / (log $b) }

my %passed;
my $num_distincts = 0;
for my $n (2 .. 100) {
  my $max_i = 100 * floor logn($n, 100);
  for my $i (2 .. $max_i) {
    my $is_dist = 0;
    for my $d (divisors $i) {
      my ($m, $j) = ($n ** $d, $i / $d);
      next if $passed{$m, $j};
      next if $j > 100;
      last if $m > 100;

      $passed{$m, $j} = $is_dist = 1;
    }
    $num_distincts++ if $is_dist;
  }
}
say $num_distincts;


蛇足な補足

実装にちょっと珍しい多次元配列のエミュレート機能を使っています。$passed{$m, $j}という部分です。
ぱっと見ハッシュ・スライスのようですが、シジルが$なことから分かるようにスカラ値を返します。

これは次のように解釈されます：

$passed{ join($;, $m, $j) }


Perl 5のハッシュが文字列しかキーにできないという制約からこのような形になっているのでしょう。$;（use Englishすると$SUBSEP）は特殊変数で、デフォルトでは"¥034"が入っています。これはUS-ASCIIではFS(File Separator)という制御文字なので、キーの値と混同されることはまずありません。

Pythonなどのタプルをキーとする方法に比べると美しくありませんが、使い勝手に差はないので案外と重宝します。疎な多次元配列を作るときなどは配列リファレンスよりこちらの方がいいでしょう。



Project Euler - Problem 28
2009-04-20T22:31:00.000+09:00
問題

再開言っておきながら10日も開いてしまいました。今度こそ再開します。きっと。


原文


  What is the sum of both diagonals in a 1001 by 1001 spiral formed in the same way?

日本語訳


  1001・1001の螺旋を同じ方法で生成したとき, 対角線上の数字の合計はいくつだろうか?



解答

1周する毎に数字の間隔が2広がるわけですから、単純に書いて十分早く答えが出ます。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;

my $sum = 1;
for (my ($i, $step) = (1, 2); $i < 1001 * 1001; $step += 2) {
  $sum += $i += $step for 1 .. 4;
}

say $sum;



Project Euler - Problem 27
2009-04-10T23:42:00.007+09:00
問題

しばらく止まってましたが今日から再開。


原文


  Considering quadratics of the form:

n² + an + b, where |a| < 1000 and |b| < 1000

Find the product of the coefficients, a and b, for the quadratic expression that produces the maximum number of primes for consecutive values of n, starting with n = 0.

日本語訳


  |a| < 1000, |b| < 1000 として以下の二次式を考える (ここで|a|は絶対値):

n² + an + b

n=0から始めて連続する整数で素数を生成したときに最長の長さとなる上の二次式の, 係数a, bの積を答えよ.



解答

最大探索範囲は-999 <= a <= 999、-999 <= b <= 999なので、およそ4,000,000通りの係数の組合せを試すことになります。組合せ毎に数列を生成して、それが素数か判定するわけですからたまりません。簡単な検討を加えて範囲を絞りましょう。

与えられた二次式をf(n)とおくと、f(0) = b、f(1) = a + b + 1です。
f(n)が長さ2以上の素数列を生成するならこれらは素数ですから、次のことがいえます：


bは素数である
a + b + 1は素数である
b = 2のとき、aは偶数である
それ以外のとき、aは奇数である


素数判定関数is_primeには同じ引数が与えられることがよくあるのでメモ化しています。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;

sub prime_seq_len($$) {
  my ($coeff_a, $coeff_b) = @_;
  my $len = 0;
  my $n = 0;
  $len++, $n++ while is_prime($n * ($n + $coeff_a) + $coeff_b);
  return $len;
}

{
  my %primes = ( 2 => 1 );
  sub is_prime(_) {
    my $n = abs shift;

    unless (exists $primes{$n}) {
      return 0 if $n < 2 or $n % 2 == 0;

      my $is_prime = 1;
      for (my $i = 3; $i <= sqrt $n; $i += 2) {
        if ($n % $i == 0) {
          $is_prime = 0;
          last;
        }
      }
      $primes{$n} = $is_prime;
    }

    return $primes{$n};
  }
}

my $longest = 0;
my $product;
for my $coeff_b (grep { is_prime } -999 .. 999) {
  my $modulo = $coeff_b == 2 ? 0 : 1;
  my @a_cands = grep { $_ % 2 == $modulo
                         and is_prime($_ + $coeff_b + 1) } -999 .. 999;
  for my $coeff_a (@a_cands) {
    my $len = prime_seq_len($coeff_a, $coeff_b);
    if ($longest < $len) {
      $longest = $len;
      $product = $coeff_a * $coeff_b;
    }
  }
}

say $product;


追記

コメントで匿名氏に御指摘いただきました。

b = n = 2とするとf(2) = 2² + 2a + 2となり、これは明らかに（2より大きい）偶数です。
つまりb = 2のとき、生成する素数列の長さは高々2であり、無視できることになります。

前掲のコードでb = 2のケースを考慮している部分（$moduloのあたり）は不要になりました：

my $longest = 0;
my $product;
for my $coeff_b (grep { is_prime } -999 .. 999) {
  my @a_cands = grep { $_ % 2 != 0
                         and is_prime($_ + $coeff_b + 1) } -999 .. 999;
  for my $coeff_a (@a_cands) {
    my $len = prime_seq_len($coeff_a, $coeff_b);
    if ($longest < $len) {
      $longest = $len;
      $product = $coeff_a * $coeff_b;
    }
  }
}

say $product;



Project Euler - Problem 26
2009-04-05T23:43:00.002+09:00
問題


原文


  Find the value of d < 1000 for which 1/d contains the longest recurring cycle in its decimal fraction part.

日本語訳


  d < 1000 なる 1/d の中で循環節が最も長くなるような d を求めよ。



解答

筆算の過程から類推できるように、この問題は同じ余りが出るまでの間隔を調べる問題に置き替えることができます。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/reduce/;

sub rec_cycle_period($$) {
  my ($deno, $upper_lim) = @_;
  my %appeared_rems;
  my $remainder = 10;
  my $i = 0;
  do {
    return 0 if $remainder == 0;
    return -1 if $i >= $upper_lim;
    $appeared_rems{$remainder} = $i++;
    $remainder %= $deno;
    $remainder *= 10;
  } until exists $appeared_rems{$remainder};
  return $i - $appeared_rems{$remainder};
}

say
  map { $_->[0] }
  reduce { $a->[1] > $b->[1] ? $a : $b }
  map { [$_, rec_cycle_period($_, 1000)] } 1 .. 1000;



Project Euler - Problem 25
2009-04-03T20:28:00.000+09:00
問題


原文


  What is the first term in the Fibonacci sequence to contain 1000 digits?

日本語訳


  1000桁になる最初の項の番号を答えよ.



解答

Gaucheのストリームライブラリを使ってみました。

(use util.stream)

(define fibonacci-sequence
  (iterator->stream
   (lambda (yield end)
     (let loop ((a 1) (b 1))
       (yield a)
       (loop b (+ a b))))))

(define (digits n)
  (define (digits-1 m acc)
    (if (< n m) acc
        (digits-1 (* m 10) (+ acc 1))))
  (digits-1 1 0))

(define (solve)
  (+ 1 (stream-index (lambda (n) (= 1000 (digits n)))
                     fibonacci-sequence)))

(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 24
2009-04-03T13:07:00.004+09:00
問題


原文


  What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9?

日本語訳


  0,1,2,3,4,5,6,7,8,9からなる順列を辞書式に並べたときの100万番目を答えよ



解答

n (> 0)桁目の数字が決まると残りの数字の順列は(n - 1)!通りですから、一般にn桁の順列の（0から数えて）m番目というとき、m = p_n(n - 1)! + p_n-1(n - 2)! + ... + p₁(0)! (0 <= p_i < i)と表すと、p_n, p_n-1, ..., p₁の値は一意に定まります。
よってn桁目の数字を決めるとき、その時点で使える数字を昇順に並べた中からp_n番目の数字を選ぶという操作をn = 1まで繰り返すことで解が得られます。

(use srfi-1)

(define (factorial n) (apply * (iota n 1)))

(define (solve)
  (define (solve-1 n digits acc)
    (if (null? digits) (list->string (map integer->digit (reverse acc)))
        (let* ((fact (factorial (- (length digits) 1)))
               (mult (floor (/ n fact)))
               (digit (ref digits mult))
               (rest (remove (cut = digit <>) digits)))
          (solve-1 (- n (* fact mult)) rest (cons digit acc)))))
  (solve-1 (- 1000000 1) (iota 10) '()))

(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 23
2009-04-02T23:45:00.001+09:00
問題


原文


  Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers.

日本語訳


  2つの過剰数の和で書き表せない正の整数の総和を求めよ.



解答

Problem 21を解くときに使ったdivisorsを流用してブルートフォース。small-sigmaは約数関数です。

(use srfi-1)

(define (divisors n)
  (define (divisor? m) (zero? (reremainder n m)))
  (let loop ((i 1) (early '()) (later '()))
    (if (> (* i i) n) (append-reverse early later)
        (cond
         ((= (* i i) n) (loop (+ i 1) (cons i early) later))
         ((divisor? i) (loop (+ i 1) (cons i early) (cons (/ n i) later)))
         (else (loop (+ i 1) early later))))))

;;; divisor function
(define (small-sigma x n) (apply + (map (cut expt <> x) (divisors n))))

(define small-sigma1 (cut small-sigma 1 <>))

(define (abundant-number? n) (< (* 2 n) (small-sigma1 n)))

(define (get-sieve upper-limit)
  (define lookup-table (make-vector (+ upper-limit 1) #f))
  (define (sum-of-abundants? n) (ref lookup-table n))
  (define abundant-numbers (filter abundant-number? (iota upper-limit 1)))
  (unless (null? abundant-numbers)
          (let init-lookup-table ((i (car abundant-numbers))
                                  (rest (cdr abundant-numbers)))
            (let inner-loop ((j i) (rest-of-rest rest))
              (define sum (+ i j))
              (if (> sum upper-limit)
                  (unless (null? rest)
                          (init-lookup-table (car rest) (cdr rest)))
                  (begin
                    (set! (ref lookup-table sum) #t)
                    (unless (null? rest-of-rest)
                            (inner-loop (car rest-of-rest)
                                        (cdr rest-of-rest))))))))
  sum-of-abundants?)

(define (solve)
  (apply + (remove (get-sieve 28123) (iota 28123 1))))

(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 22
2009-03-31T23:27:00.004+09:00
問題


原文


  What is the total of all the name scores in the file?

日本語訳


  ファイル中の全名前のスコアの合計を求めよ.



解答

まさにPerlにうってつけの問題です。どこらへんに数学が必要なのかよく分かりません。

ファイルの中身はダブルクォートで囲まれた名前のカンマ区切りリストです。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum/;

open my $input, 'names.txt' or die $!;
my @names = sort map { /([A-Z]+)/; $1 } split /,/, do { local $/; <$input> };
my $line_no = 1;
my $total_score = 0;
my $ord_A = ord 'A';
for my $name (@names) {
  $total_score
    += $line_no++ * sum map { ord($_) - $ord_A + 1 } split //, $name;
}
say $total_score;



Project Euler - Problem 21
2009-03-29T23:56:00.002+09:00
問題


原文


  Evaluate the sum of all the amicable numbers under 10000.

日本語訳


  10000未満の友愛数の合計を求めよ。



解答

ほとんど書き下しただけです。注意点は完全数を計算に含めないことくらいでしょうか。

(use srfi-1)

(define (divisors n)
  (define (divisor? m) (zero? (remainder n m)))
  (let loop ((i 2) (early '()) (later '()))
    (if (> (* i i) n) (cons 1 (append-reverse early later))
        (cond
         ((= (* i i) n) (loop (+ i 1) (cons i early) later))
         ((divisor? i) (loop (+ i 1) (cons i early) (cons (/ n i) later)))
         (else (loop (+ i 1) early later))))))

(define (d n) (apply + (divisors n)))

(define (amicable-number? n)
  (define m (d n))
  (and (not (= n m)) (= n (d m))))

(define (solve)
  (apply + (filter amicable-number? (iota (- 10000 1) 1))))

(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 20
2009-03-29T23:19:00.003+09:00
問題


原文


  Find the sum of the digits in the number 100!

日本語訳


  100! の各桁の数字の合計を求めよ。



解答

毎度のことですがMath::BigIntのお世話になりました。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/sum reduce/;
use Math::BigInt;

sub factorial(_) {
  no warnings qw/once/;
  my $n = shift;
  return 1 if $n == 0;
  reduce { Math::BigInt->new($a) * Math::BigInt->new($b) } 1 .. $n;
}

say sum split //, factorial(Math::BigInt->new(100));



Project Euler - Problem 19
2009-03-28T23:45:00.000+09:00
問題


原文


  How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

日本語訳


  20世紀（1901年1月1日から2000年12月31日）で月の初めの日曜日の数を数えよ。



解答

単純な2重ループで足し合わせていくだけです。

(use srfi-1)

(define (leap-year? year)
  (cond
   ((and (zero? (remainder year 100)) (not (zero? (remainder year 400)))) #f)
   ((zero? (remainder year 4)) #t)
   (else #f)))

(define (days-of year month)
  (case month
    ((1 3 5 7 8 10 12) 31)
    ((4 6 9 11) 30)
    ((2) (if (leap-year? year) 29 28))))

(define (day-of-week-after wday days)
  (define offset
    (case wday
      ((Sun) 0)
      ((Mon) 1)
      ((Tue) 2)
      ((Wed) 3)
      ((Thu) 4)
      ((Fri) 5)
      ((Sat) 6)))
  (list-ref '(Sun Mon Tue Wed Thu Fri Sat)
            (remainder (+ offset days) 7)))

(define (solve)
  (define wday-of-1-Jan-1901
    (day-of-week-after 'Mon
                       (apply + (map (cut days-of 1900 <>)
                                     (iota 12 1)))))
  (let yearly-loop ((sundays 0)
                    (wday wday-of-1-Jan-1901)
                    (year 1901))
    (if (> year 2000) sundays
        (receive (sundays-of-this-year first-wday-of-next-year)
                 (let monthly-loop ((sundays 0)
                                    (wday wday)
                                    (month 1))
                   (if (> month 12) (values sundays wday)
                       (monthly-loop
                        (if (eq? wday 'Sun) (+ sundays 1) sundays)
                        (day-of-week-after wday (days-of year month))
                        (+ month 1))))
                 (yearly-loop (+ sundays sundays-of-this-year)
                              first-wday-of-next-year
                              (+ year 1))))))

(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 18
2009-03-28T22:27:00.001+09:00
問題


原文


  Find the maximum total from top to bottom of the triangle

日本語訳


  三角形を頂点から下まで移動するとき、その最大の合計値を求めよ。



解答

動的計画法を使ってボトムアップで簡単に解くことができる問題です。

簡単のため、小さい三角形で考えることにします：

0:    j
1:   h i
2:  e f g
3: a b c d


2行目の各点を頂点として、2行の小さい三角形が作れることが分かります。
上の例で言えば、(e, a, b)と(f, b, c)、(g, c, d)の3つです。
(e, a, b)の頂点eから末端（a、b、c、dのいずれか）に移動したとき、その数値の合計は最大でe + max(a, b)となります（maxは最大値を選ぶ関数）。同様に他の2つもf + max(b, c)、g + max(c, d)と表せます。
これらをE、F、Gとおくことにして、例を次のように書き換えます：

0:   j
1:  h i
2: E F G


(h, E, F)からなる三角形の最大値はH = h + max(E, F)、(i, F, G)からなる三角形のそれはI = i + max(F, G)です。
Eは「頂点eから末端に至る経路の最大値」で、FやGも同様ですから、HとIは「頂点h（やi）から末端に至る経路の最大値」となります。

これを先ほどと同様に置き換えて：

0:  j
1: H I


頂点jから末端に至る経路の最大値はJ = j + max(H, I)となり、これが解です。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/max/;

my @rows = map { [ split /\s+/ ] } <DATA>;
until (@rows == 1) {
  my $curr_row = $rows[-2];
  my $bigger_branch;
  for (my $i = 0; $i < @$curr_row; $i++) {
    $bigger_branch = max $rows[-1][$i], $rows[-1][$i + 1];
    $curr_row->[$i] += $bigger_branch;
  }
  $#rows--;
}

say $rows[0][0];

__END__
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23



Project Euler - Problem 17
2009-03-25T22:46:00.001+09:00
問題


原文


  If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used? 

日本語訳


  1 から 1000 (one thousand) までの数字をすべて英単語で書けば、全部で何文字になるか。



解答

どう考えても数値計算じゃなくて文字列処理の問題です。つまりPerlの出番です。
数値を英語表現に変換する必要がありますが、Lingua::EN::NumbersというCPANモジュールがまさにその機能を持っています。

以前のバージョンではイギリス/アメリカ英語の切り替え機能を持っていたようですが、現在は削除されています。生成される英語表現はイギリス英語が元になっているようなので、当座の用は満たせます。

コードの本質的な箇所ではありませんが、Perl 5.10から関数プロトタイプに_を指定できるようになりました。
これを使うと、引数が省略されたとき$_の値を使うという組み込み関数と同様の挙動を簡単に実現できます。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use Lingua::EN::Numbers qw/num2en/;
use List::Util qw/sum/;

sub num_of_chars_in_english(_) {
  my $english_expr = num2en shift;
  $english_expr =~ tr/a-z//;
}

say sum map { num_of_chars_in_english } 1 .. 1000;



Project Euler - Problem 16
2009-03-25T19:26:00.002+09:00
問題


原文


  What is the sum of the digits of the number 2^(1000)?

日本語訳


  2¹⁰⁰⁰ の各数字の合計を求めよ。



解答

Gaucheの整数精度は無制限（実はR5RSでは要求されていない。驚き）なので特に悩む必要はありません。

(define (solve)
  (apply + (map digit->integer (string->list (number->string (expt 2 1000))))))
(define (main argv)
  (display (solve))
  (newline))


ついでにPerl 5.10の一行野郎。

perl -Mbigint -MList::Util=sum -E"say sum split //, 2 ** 1000"



Project Euler - Problem 15
2009-03-24T23:43:00.003+09:00
問題


原文


  How many routes are there through a 20・20 grid?

日本語訳


  20 ・ 20 のマス目ではいくつのルートがあるか。



解答

グリッド上の座標を(x, y)で表すこととし、左上の始点を(0, 0)、右下の終点を(20, 20)と定めます。
座標(x, y)から(20, 20)へのルート数をroutesFrom(x, y)と書くことにすると、この問題はroutesFrom(0, 0)を求める問題に相当します。
routesFrom(x, y)は次のようにして求められます：


routesFrom(x, y) = 1 (x = 20, y = 20)
routesFrom(x, y) = 0 (x > 20 or y > 20)
routesFrom(x, y) = routesFrom(x + 1, y) + routesFrom(x, y + 1) (otherwise)


routesFrom(0, 0)の計算量はグリッドの大きさnの増加に対応して急激に大きくなります（多分計算量の上限はO(2^n)くらい）。
routesFrom(0, 0) = routesFrom(1, 0) + routesFrom(0, 1) = routesFrom(2, 0) + routesFrom(1, 1) + routesFrom(1, 1) + routesFrom(0, 2) = ...といったように、基底ケース（上の1.と2.）に行き当たるまで倍々に項が増えていきます。今回はn=20なので、このままでは現実的な時間内に終わりません。

別々のルートが同じ座標を通ることはよくあります。先ほどの展開でroutesFrom(1, 1)という項が2回出てきているのは、(0, 0)から(1, 1)に至るルートが2つ存在するからです。
その座標に至るまでのルートに関わらずそれ以降に取り得るルートの数は同じなので、routesFrom(x, y)の値をメモ化することで膨大な計算を省くことができます。

(use srfi-1)
(define (count-routes num-cells)
  (define lookup-table (make-vector (+ num-cells 1)))
  (define (routes-from x y) (ref (ref lookup-table y) x))
  (define (count-routes-1 x y)
    (cond
     ((or (> x num-cells) (> y num-cells)) 0)
     ((and (= x num-cells) (= y num-cells)) 1)
     ((not (zero? (routes-from x y))) (routes-from x y))
     (else
      (let ((num-routes (+ (count-routes-1 (+ x 1) y)
                           (count-routes-1 x (+ y 1)))))
        (set! (routes-from x y) num-routes)
        num-routes))))
  (set! (setter routes-from)
        (lambda (x y num-routes) (set! (ref (ref lookup-table y) x) num-routes)))
  (for-each (lambda (i)
              (set! (ref lookup-table i) (make-vector (+ num-cells 1) 0)))
            (iota (+ num-cells 1)))
  (count-routes-1 0 0))
(define (solve) (count-routes 20))
(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 14
2009-03-23T21:37:00.002+09:00
問題

ある関数を繰り返し適用して得られる数列が最も長くなる初期値n（1,000,000未満）を求める問題です。


原文
日本語訳


解答

nから始まる数列の長さをlen(n)で表すと、次のように定義できます：


len(n) = 1 (n = 1)
len(n) = len(3n + 1) + 1 (nは奇数)
len(n) = len(n / 2)  + 1 (nは偶数)


つまり、len(n)の計算は1.の場合を基底ケースとする再帰アルゴリズムとして実装できます。

これをそのまま実装しても答えが得られますが、非常に遅いです。高速化の為に少し検討を加えましょう。

まず56から始まる数列を考えます。56は偶数なので3.の場合に該当し、len(56) = len(56 / 2) + 1 = len(28) + 1です。また、9から始まる数列の場合は2.に該当し、len(9) = len(3 * 9 + 1) + 1 = len(28) + 1となります。
つまりlen(56) = len(9) = len(28) + 1というわけで、len(56)とlen(9)の値は実は同じです。2.と3.の再帰式を見て予想できるように、このような重複は度々起こるので、それぞれの計算でlen(28)の計算をやり直すようなことをしていると大きな無駄となります。

これを解決するには過去に計算したlen(n)の値を覚えておき、次に同じnが与えられた時には覚えていた値を返すようにします。そうすることで2度目以降の関数呼び出しでは計算を省くことができ、時間の節約になります。これは同じ引数に対して常に同じ値を返す（つまり参照透過性がある）関数一般に使えるテクニックで、これをメモ化と呼びます。

そう言うわけで長々と説明しましたが、要はProblem 10で使ったルックアップ・テーブルと同じものです。今回はクロージャ生成時に確保されたベクタの長さより大きいnが与えられる場合（十分大きい奇数が与えられた時）が有り得るので、上限（upper-limit）より大きいnに対してはその都度計算し直しています。

(use srfi-1)
(define (get-sequence-length next-value upper-limit)
  (define lookup-table (make-vector (+ upper-limit 1) 0))
  (define (sequence-length n)
    (let ((len (if (> n upper-limit) 0 (ref lookup-table n))))
      (if (not (zero? len)) len
          (let ((len
                 (+ 1 (sequence-length (next-value n)))))
            (unless (> n upper-limit) (set! (sequence-length n) len))
            len))))
  (set! (setter sequence-length)
        (lambda (n len) (set! (ref lookup-table n) len)))
  (set! (sequence-length 1) 1)
  sequence-length)
(define (solve)
  (define sequence-length
    (get-sequence-length (lambda (n) (if (even? n) (/ n 2) (+ (* 3 n) 1)))
                         999999))
  (car (fold (lambda (a b) (if (> (cdr a) (cdr b)) a b))
             '(0 . 0)
             (map (lambda (n) (cons n (sequence-length n))) (iota 999999 1)))))
(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 13
2009-03-23T02:19:00.002+09:00
問題


原文


  Work out the first ten digits of the sum of the following one-hundred 50-digit numbers.

日本語訳


  以下の50桁の数字100個の総和の上位10桁を求めよ。



解答

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use Math::BigInt;

my $result = Math::BigInt->new(0);
$result += $_ for <DATA>;
say substr($result, 0, 10);

__DATA__
37107287533902102798797998220837590246510135740250
46376937677490009712648124896970078050417018260538
74324986199524741059474233309513058123726617309629
91942213363574161572522430563301811072406154908250
23067588207539346171171980310421047513778063246676
89261670696623633820136378418383684178734361726757
28112879812849979408065481931592621691275889832738
44274228917432520321923589422876796487670272189318
47451445736001306439091167216856844588711603153276
70386486105843025439939619828917593665686757934951
62176457141856560629502157223196586755079324193331
64906352462741904929101432445813822663347944758178
92575867718337217661963751590579239728245598838407
58203565325359399008402633568948830189458628227828
80181199384826282014278194139940567587151170094390
35398664372827112653829987240784473053190104293586
86515506006295864861532075273371959191420517255829
71693888707715466499115593487603532921714970056938
54370070576826684624621495650076471787294438377604
53282654108756828443191190634694037855217779295145
36123272525000296071075082563815656710885258350721
45876576172410976447339110607218265236877223636045
17423706905851860660448207621209813287860733969412
81142660418086830619328460811191061556940512689692
51934325451728388641918047049293215058642563049483
62467221648435076201727918039944693004732956340691
15732444386908125794514089057706229429197107928209
55037687525678773091862540744969844508330393682126
18336384825330154686196124348767681297534375946515
80386287592878490201521685554828717201219257766954
78182833757993103614740356856449095527097864797581
16726320100436897842553539920931837441497806860984
48403098129077791799088218795327364475675590848030
87086987551392711854517078544161852424320693150332
59959406895756536782107074926966537676326235447210
69793950679652694742597709739166693763042633987085
41052684708299085211399427365734116182760315001271
65378607361501080857009149939512557028198746004375
35829035317434717326932123578154982629742552737307
94953759765105305946966067683156574377167401875275
88902802571733229619176668713819931811048770190271
25267680276078003013678680992525463401061632866526
36270218540497705585629946580636237993140746255962
24074486908231174977792365466257246923322810917141
91430288197103288597806669760892938638285025333403
34413065578016127815921815005561868836468420090470
23053081172816430487623791969842487255036638784583
11487696932154902810424020138335124462181441773470
63783299490636259666498587618221225225512486764533
67720186971698544312419572409913959008952310058822
95548255300263520781532296796249481641953868218774
76085327132285723110424803456124867697064507995236
37774242535411291684276865538926205024910326572967
23701913275725675285653248258265463092207058596522
29798860272258331913126375147341994889534765745501
18495701454879288984856827726077713721403798879715
38298203783031473527721580348144513491373226651381
34829543829199918180278916522431027392251122869539
40957953066405232632538044100059654939159879593635
29746152185502371307642255121183693803580388584903
41698116222072977186158236678424689157993532961922
62467957194401269043877107275048102390895523597457
23189706772547915061505504953922979530901129967519
86188088225875314529584099251203829009407770775672
11306739708304724483816533873502340845647058077308
82959174767140363198008187129011875491310547126581
97623331044818386269515456334926366572897563400500
42846280183517070527831839425882145521227251250327
55121603546981200581762165212827652751691296897789
32238195734329339946437501907836945765883352399886
75506164965184775180738168837861091527357929701337
62177842752192623401942399639168044983993173312731
32924185707147349566916674687634660915035914677504
99518671430235219628894890102423325116913619626622
73267460800591547471830798392868535206946944540724
76841822524674417161514036427982273348055556214818
97142617910342598647204516893989422179826088076852
87783646182799346313767754307809363333018982642090
10848802521674670883215120185883543223812876952786
71329612474782464538636993009049310363619763878039
62184073572399794223406235393808339651327408011116
66627891981488087797941876876144230030984490851411
60661826293682836764744779239180335110989069790714
85786944089552990653640447425576083659976645795096
66024396409905389607120198219976047599490197230297
64913982680032973156037120041377903785566085089252
16730939319872750275468906903707539413042652315011
94809377245048795150954100921645863754710598436791
78639167021187492431995700641917969777599028300699
15368713711936614952811305876380278410754449733078
40789923115535562561142322423255033685442488917353
44889911501440648020369068063960672322193204149535
41503128880339536053299340368006977710650566631954
81234880673210146739058568557934581403627822703280
82616570773948327592232845941706525094512325230608
22918802058777319719839450180888072429661980811197
77158542502016545090413245809786882778948721859617
72107838435069186155435662884062257473692284509516
20849603980134001723930671666823555245252804609722
53503534226472524250874054075591789781264330331690


...すいません、手抜きです。でもこういうのは軽量言語の役得じゃないですかね。Cだって別にGMP使ってもいいわけだし。
「まっとうな」やり方だと10桁程度ずつに区切って、それぞれを合算した上で桁上がり分を上の桁に加えるような手順で計算できるはずです。やらないけど。



Project Euler - Problem 12
2009-03-23T01:37:00.004+09:00
問題


原文


  What is the value of the first triangle number to have over five hundred divisors?

日本語訳


  501 個以上の約数をもつ最初の三角数はいくらか。



解答

約数の個数は素因数分解の結果から求めることができます。
例えばn = p^a * q^b（pとqは素数）という合成数がある場合、約数は以下の表のようになります：


1 p p² ... p^a
q p * q p² * q p^a * q
q² p * q² p² * q² p^a * q²
...
q^b p * q^b p² * q^b p^a * q^b


p⁰ = q⁰ = 1であることを考えれば、0..aの(a + 1)通りのpのべき乗と、0..bの(b + 1)通りのqのべき乗を掛け合わせた数がnの約数であることが分かります。
これは素因数が3つ以上の場合も同様で、一般にp^a * q^b * r^c * ...の約数は(a + 1)(b + 1)(c + 1)...個存在します。

Problem 3で使った素因数分解を行う関数factorizeを改良し、各素因数について、べき乗回数をcdrに入れたペアのリストを返すようにしました。

(define (triangle-number n) (* (+ 1 n) (/ n 2)))
(define (factorize n)
  (define max-divisor (floor->exact (sqrt n)))
  (define (factorize-1 n div result)
    (if (> div max-divisor)
        (if (= n 1) result (cons (cons n 1) result))
        (let count ((n n) (i 0))
          (define (divisor? m) (zero? (modulo n m)))
          (if (divisor? div) (count (/ n div) (+ i 1))
              (factorize-1 n (+ div 2)
                           (if (zero? i) result
                               (cons (cons div i) result)))))))
  (let prepare ((n n) (i 0))
    (if (even? n) (prepare (/ n 2) (+ i 1))
        (factorize-1 n 3 (if (zero? i) '() (cons (cons 2 i) '()))))))
(define (num-of-divisors-of n)
  (apply * (map (lambda (factor) (+ (cdr factor) 1)) (factorize n))))
(define (solve)
  (let loop ((i 1))
    (define tri (triangle-number i))
    (if (> (num-of-divisors-of tri) 500) tri
        (loop (+ i 1)))))
(define (main argv)
  (display (solve))
  (newline))


参考文献


mathschallenge.net



Project Euler - Problem 11
2009-03-22T22:03:00.001+09:00
問題


原文


  What is the greatest product of four adjacent numbers in any direction (up, down, left, right, or diagonally) in the 20・20 grid?

日本語訳


  上下左右斜めのいずれかの方向で連続する4つの数字の積のうち最大のものを求めよ。



解答

単なる総当り問題です。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/max reduce/;

my @grid = map { chomp; [ split /\s+/ ] } <DATA>;
my @products;
OUTER:
for (my $i = 0; $i < @grid; $i++) {
  my $curr_row = $grid[$i];
  for (my $j = 0; $j < @$curr_row; $j++) {
    last OUTER if $i >= @grid - 3 and $j >= @$curr_row - 3;

    if ($j < @$curr_row - 3) {
      push @products, reduce { $a * $b } map { $grid[$i][$j + $_] } 0 .. 3;
    }
    if ($i < @grid - 3) {
      push @products, reduce { $a * $b } map { $grid[$i + $_][$j] } 0 .. 3;
    }
    if ($i < @grid - 3 and $j < @$curr_row - 3) {
      push @products,
        reduce { $a * $b } map { $grid[$i + $_][$j + $_] } 0 .. 3;
    }
    if ($i < @grid - 3 and $j >= 3) {
      push @products,
        reduce { $a * $b } map { $grid[$i + $_][$j - $_] } 0 .. 3;
    }
  }
}
say max @products;

__END__
08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08
49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00
81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65
52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91
22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80
24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50
32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70
67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21
24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72
21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95
78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92
16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57
86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58
19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40
04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66
88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69
04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36
20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16
20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54
01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48



Project Euler - Problem 10
2009-03-22T03:34:00.006+09:00
問題


原文


  Find the sum of all the primes below two million.

日本語訳


  200万以下の全ての素数の和を計算しなさい.



解答

素数を探す点はProblem 7と同様ですが、2,000,000以下の素数は148,933個も存在するので計算量は文字通り桁違いです。
アルゴリズムを替えるほどではありませんが、以前のコードは大きなリストを何度もコピーし、filterにかけているので低速です。
ベクタを使ったルックアップ・テーブルを事前に用意し、filterの適用も1回に抑えることで3倍程度高速化しました。2以外の偶数が素数でないのは明らかなので、奇数のみを篩にかけ、後から2とconsしています。

SRFI-17のsetterを使ってベクタの書き換えを抽象化しています。

(use srfi-1)

(define (get-sieve upper-limit)
  (define lookup-table (make-vector (+ upper-limit 1) #t))
  (define (prime? n) (ref lookup-table n))
  (set! (setter prime?) (lambda (n retval) (set! (ref lookup-table n) retval)))
  (set! (prime? 0) #f)
  (set! (prime? 1) #f)
  (let sieve-evens ((i 4))
    (unless (> i upper-limit)
            (set! (prime? i) #f)
            (sieve-evens (+ i 2))))
  (let sieve-odds ((i 3))
    (unless (> (* i i) upper-limit)
            (when (prime? i)
                  (let inner-loop ((j (* i i)))
                    (unless (> j upper-limit)
                            (set! (prime? j) #f)
                            (inner-loop (+ j (* i 2))))))
            (sieve-odds (+ i 1))))
  prime?)

(define (solve)
  (define prime? (get-sieve 2000000))
  (apply + (cons 2 (filter prime? (iota (- 1000000 1) 3 2)))))

(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 9
2009-03-21T22:24:00.001+09:00
問題


原文


  There exists exactly one Pythagorean triplet for which a + b + c = 1000.
Find the product abc.

日本語訳


  a + b + c = 1000となるピタゴラスの三つ組が一つだけ存在する. このa,b,cの積を計算しなさい.



解答

何の変哲もない2重ループです。

(define (square n) (* n n))
(define (solve)
  (let outer-loop ((i 1))
    (let inner-loop ((j 1))
      (define k (sqrt (+ (square i) (square j))))
      (cond
       ((= (+ i j k) 1000) (* i j (inexact->exact k)))
       ((> (+ i j k) 1000) (outer-loop (+ i 1)))
       (else               (inner-loop (+ j 1)))))))
(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 8
2009-03-20T19:37:00.006+09:00
問題


原文


  Find the greatest product of five consecutive digits in the 1000-digit number.

日本語訳


  1000桁の数字から5つの連続する数字を取り出してその積を計算する。そのような積の中で最大のものの値はいくらか。



解答

計算よりデータの読み込みが面倒です。Perl 5を使って解くことにしました。
do { local $/; <FILE_HANDLE> }はファイル一気読みのイディオムですが、改行文字を落とすためにgrepをかけています。

#!/usr/bin/perl

use strict;
use warnings;
use feature qw/say/;
use List::Util qw/reduce/;

my @digits = do { local $/; grep /\d/, split //, <DATA> };
my $max = 0;
until (5 > @digits) {
  no warnings qw/once/;
  my $product = reduce { $a * $b } @digits[0 .. 4];
  $max = $product if $max < $product;
  shift @digits;
}

say $max;

__DATA__
73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450



Schemeでカリー化
2009-03-20T14:06:00.005+09:00
Haskellの有名な特徴として、関数が勝手にカリー化されるという点があります。
要するにHaskellの関数は常に部分適用可能になっていて、f foo bar bazという関数適用は(((f foo) bar) baz)と解釈されています。これは非常に強力な機能で、汎用的な関数を目的に合わせて簡単に特殊化することができます。

Schemeやその他のLispでは、引数は必ず同時に与えないといけないので、カリー化したものを作ろうとするとクロージャを使って(define f (lambda (x) (lambda (y) (lambda (z) ...))))とでもしなければなりません。しかも呼び出すときには(((f foo) bar) baz)と、1つずつ順番に適用する必要があります。
私が欲しいのは、"（Haskellが透過的にやっているように）与えられた引数を先頭から順に束縛し、足りない分を引数とするクロージャを返す"ような関数です。((f foo) bar baz)だろうが(f foo bar baz)だろうが(((f foo) bar) baz)だろうが同じ結果を返す関数を作りたいわけです。そこで、カリー化関数を作成するマクロを書きました。

(define-syntax curry
  (syntax-rules ()
    ((_ (arg0) body ...) (lambda (arg0) body ...))
    ((_ (arg0 arg1 ...) body ...)
     (lambda (arg0 . rest)
       (define applied (curry (arg1 ...) body ...))
       (if (null? rest) applied
           (apply applied rest))))))


このマクロを使って作成した関数は、引数を先頭から束縛していき、すべての引数が揃ったときに値を返します。

(define greet (curry (when who)
                     (display
                          (string-append "good "
                                         when ", " who "."
                                         " how are you?"))
                     (newline)))
(greet "morning" "John")   ;;; prints "good morning, John. how are you?"
((greet "morning") "John") ;;; same as above


バグなどありましたらコメントで教えてください。



Project Euler - Problem 7
2009-03-20T02:04:00.003+09:00
問題


原文


  What is the 10001st prime number?

日本語訳


  10001 番目の素数を求めよ。



解答

素数判定といえばエラトステネスの篩という有名なアルゴリズムがあります。
それを実装したのが下記のeratosで、与えられたリスト（昇順に並んでいると仮定）を篩にかけ、残った数値をリストにして返します。リストを先頭の要素と残りに分割するというのはHaskellやPerlなどでよく見かけるパターンですが、SchemeでもSRFI-1のcar+cdrを使って簡潔に書けます。
take-primesは与えられた個数以上の素数が得られるまで、リストを拡張しながらeratosを繰り返し適用し、得られたリストから与えられた個数の素数を返します。

(use srfi-1)
(define (eratos xs)
  (define (eratos-1 xs result)
    (if (null? xs) (reverse result)
        (let ((last-num (last xs)))
          (receive (n ns) (car+cdr xs)
                   (if (< last-num (* n n)) (append (reverse result) xs)
                       (let ((not-multiple-of-n?
                              (lambda (m) (not (zero? (modulo m n))))))
                         (eratos-1 (filter not-multiple-of-n? ns)
                                   (cons n result))))))))
  (eratos-1 xs '()))
(define (take-primes num-primes)
  (define (take-primes-1 primes)
    (if (< num-primes (length primes)) (take primes num-primes)
        (take-primes-1 (eratos (append primes
                                       (iota num-primes
                                             (+ (last primes) 2)
                                             2))))))
  (take-primes-1 '(2 3)))
(define (solve)
  (last (take-primes 10001)))
(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 6
2009-03-19T16:51:00.002+09:00
問題


原文


  Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum.

日本語訳


  最初の100個の自然数について和の二乗と二乗の和の差を求めよ。



解答

これまた簡単な問題。ほとんど問題を書き下すだけの作業です。

(use srfi-1)
(define (solve)
  (define nums (iota 100 1))
  (define sum-of-squares
    (apply + (map (lambda (n) (expt n 2)) nums)))
  (define square-of-sum
    (expt (apply + nums) 2))
  (- square-of-sum sum-of-squares))
(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 5
2009-03-19T14:42:00.007+09:00
問題


原文


  What is the smallest number that is evenly divisible by all of the numbers from 1 to 20?

日本語訳


  1 から 20 までの整数全てで割り切れる数字の中で最小の値はいくらになるか。



解答

いきなり難易度が下がりました。人はそれを最小公倍数と呼びます。
Schemeには組み込み関数lcmがあるので、何も面白くありません。

(use srfi-1)
(define (solve)
  (apply lcm (iota 20 1)))
(define (main argv)
  (display (solve))
  (newline))


これでおしまい。せっかくなのでPerl 6版のgcd/lcm関数でも貼っておきます。

subset NonZeroInt of Int where { $_ != 0 }
sub gcd(NonZeroInt $m is copy, NonZeroInt $n is copy, NonZeroInt *@rest) {
  $m = -$m if $m < 0;
  $n = -$n if $n < 0;
  $m, $n = $n, $m if $m < $n;
  my Int $mod = $m % $n;
  my Int $gcd = $mod == 0 ?? $n !! gcd($n, $mod);
  +@rest == 0 ?? $gcd !! gcd($gcd, |@rest);
}
sub lcm(NonZeroInt $m is copy, NonZeroInt $n is copy, NonZeroInt *@rest) {
  $m = -$m if $m < 0;
  $n = -$n if $n < 0;
  my Int $lcm = $m * $n / gcd($m, $n);
  +@rest == 0 ?? $lcm !! lcm($lcm, |@rest);
}



Project Euler - Problem 4
2009-03-19T13:49:00.004+09:00
問題


原文


  Find the largest palindrome made from the product of two 3-digit numbers.

日本語訳


  3桁の数の積で表される回文数のうち最大のものはいくらになるか。



解答

3桁の数値なので、考えられる項は100 .. 999です。つまりナイーブな実装では、900 * 900 = 810,000回の乗算を行う必要があります。これは不可能な大きさではありません。というより私がまともな解法を思いつかないので、今回はこれで。

まず回文数かどうか判定する述語を作ります。palindromic-number?という関数がそれです。やっていることは単純で、数値を文字列に変換した上で反転したものと比較しているだけです。文字列の反転はSRFI-13のstring-reverseで可能です。
実際には文字列の前半と、反転させた後半のみを比較すれば良いのですが、文字列を切り出すコストの方が高いのでそのまま比較しています。

実際の探索を行っているsolveは単純で、すべての積を計算した上で、その中から回文数をSRFI-1のfilterで抽出してリストpalinsとし、そこからmaxで最大値を選び出します。
簡単な最適化として、例えば100 * 101と101 * 100は同じなので、無駄な計算を省くために100 <= i <= j <= 999が常に成り立つように内側のmapに渡すリストを工夫しています。これによって乗算の回数をおよそ半分にできます。

これまでの問題がミリ秒単位で計算できたのに比べると今回のプログラムは時間がかかりますが、数秒で計算できると思います。

(use srfi-1)
(use srfi-13)
(define (palindromic-number? n)
  (define n-str (number->string n))
  (string=? n-str (string-reverse n-str)))
(define (solve)
  (define palins
    (filter palindromic-number?
            (apply append
                   (map (lambda (i)
                          (map (lambda (j) (* i j)) (iota (- 1000 i) i)))
                        (iota 900 100)))))
  (apply max palins))
(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 3
2009-03-19T02:00:00.008+09:00
問題


原文


  What is the largest prime factor of the number 600851475143 ?

日本語訳


  600851475143 の素因数のうち最大のものを求めよ。



解答

いきなり難易度が上がりました。素因数分解の問題です。
結局のところ片っ端から割ってみるしかないのですが、探索範囲を狭めることはできます。

正の整数の範囲で考えると、l = m * nかつm >= nであれば、floor(sqrt(l)) >= nであることが直感的に分かります。ここでfloorは実数を0の方向に丸めて整数にする関数、sqrtは平方根を返す実数関数です。
nが分かれば、mは除算で求められます。つまりlが与えられた時、それを2つの因数に分解するのに探索する範囲は高々2 .. floor(sqrt(l))で十分ということです。
2つに分けられたならこっちのもの、得られたmとnを再帰的に分解して、その結果を合わせれば素因数分解の結果が得られます。
アルゴリズムを書き下すと次のようになります：


n <- floor(sqrt(l))とする。
n = 1なら、これ以上は分解できない（lは素数である）のでlをそのまま返す。
nがlの因数なら、m <- l / nとし、mとnに対してこのアルゴリズムを再帰的に適用し、その結果を連結して返す。
因数でないなら、n <- n - 1とし、2.から繰り返す。


これで計算は可能です。しかしもう少し最適化を検討してみましょう。

偶数は一般に2mの形で表せます。同様に奇数は2m + 1と書けます。
偶数同士の積は2m * 2n = 4mnとなり、l = 2mnとおけば2lなのでこれも偶数です。
奇数同士の積は(2m + 1)(2n + 1) = 4mn + 2(m + n) + 1であり、l = 2mn + m + nとすると2l + 1なのでこれも奇数です。
偶数と奇数の積は2m(2n + 1) = 4mn + 2mなので、l = 2mn + mとおいて2lなので偶数です。
つまり、奇数の因数は必ず奇数のみから成るということが分かります。先ほどのアルゴリズムでは、4.のステップでn <- n - 1としていました。これではlとnが両方とも奇数の時、1回不要な繰り返しが生じることになります。つまりこの場合を特別扱いして、n <- n - 2とすれば繰り返しを減らすことができます。
幸い、問題で与えられた600851475143という数値は奇数なので、この最適化の恩恵を十分に受けることができます。

この最適化を施したところ、40%ほど高速化しました。上の考察におけるlはn、nはdivという名前になっています。

(define (divisor-of? n m) (zero? (modulo m n)))
(define (factorize n)
  (define div (inexact->exact (floor (sqrt n))))
  (define (factorize-1 n div)
    (cond
     ((= div 1) (list n))
     ((and (odd? n) (even? div)) (factorize-1 n (- div 1)))
     ((divisor-of? div n) (append (factorize (/ n div)) (factorize div)))
     ((odd? n) (factorize-1 n (- div 2)))
     (else (factorize-1 n (- div 1)))))
  (factorize-1 n div))
(define (solve)
  (apply max (factorize 600851475143)))
(define (main argv)
  (display (solve))
  (newline))


追記

コメントの匿名氏のコードを基にしたところ500倍高速になりました。よって上記の議論は忘れて手続き的に書いた方が良さげ。
多値を扱うのにSRFI-8のreceiveマクロを使っています。

(define (divisor-of? m n) (zero? (modulo n m)))
(define (factorize n)
  (define (factorize-1 n i result)
    (cond
     ((< n (* i i)) (reverse (if (= n 1) result (cons n result))))
     ((divisor-of? i n) (factorize-1 (/ n i) i (cons i result)))
     (else (factorize-1 n (+ i 2) result))))
  (receive (n result)
           (let prepare-loop ((n n) (result '()))
             (if (divisor-of? 2 n) (prepare-loop (/ n 2) (cons 2 result))
                 (values n result)))
           (factorize-1 n 3 result)))
(define (solve)
  (apply max (factorize 600851475143)))
(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 2
2009-03-18T23:43:00.006+09:00
問題

4,000,000以下のフィボナッチ数列の偶数の総和を求める問題です。


原文
日本語訳


解答

これまた悩む部分はなし。フィボナッチ数列は指数関数的に大きくなるので、かなり早く答えが出ます。
SRFI-1のfirstとsecondはそれぞれリストの最初と次の要素を返すユーティリティ関数です。

(use srfi-1)
(define (solve)
  (define fibos
    (let gen-fibos-loop ((fibos '(1 1)))
      (define next-val (+ (first fibos) (second fibos)))
      (if (> next-val 4000000) fibos
          (gen-fibos-loop (cons next-val fibos)))))
  (apply + (filter even? fibos)))
(define (main argv)
  (display (solve))
  (newline))



Project Euler - Problem 1
2009-03-18T23:09:00.007+09:00
まず1問目から。日本語訳を公開してくれているWikiがあるのでそちらのページもリンクすることにします。

問題


原文


  Find the sum of all the multiples of 3 or 5 below 1000.

日本語訳


  1,000 未満の 3 か 5 の倍数になっている数字の合計を求めよ。



解答

最初の問題だけあって、別段難しくもありません。ほとんどFizzBuzz問題です。
0から999まで、公差1の等差数列から3あるいは5の倍数を抽出して合計すればいいわけです。
Scheme(Gauche)で書いてみました。multiple-of?はnがmの倍数かどうかを示す述語で、iotaはSRFI-1に収録されているリスト構築子です。

(use srfi-1)
(define (multiple-of? n m) (zero? (modulo n m)))
(define (solve)
  (apply + (filter (lambda (n) (or (multiple-of? n 3) (multiple-of? n 5)))
                   (iota 1000))))
(define (main argv)
  (display (solve))
  (newline))



0th post
2009-03-16T00:39:00.005+09:00
ようこそ。ここは情報工学を学ぶ一学生のブログです。

4月から大学編入生になるので、これからの学習記録や作ったものを公開していきたいと思います。
3月中は準備運転。当面は以前から挑戦していたProject Eulerでも進めていきます。

本ブログの目標：
3日に1回以上更新、コンスタントに！
文体はこだわらない。
ジャンルもこだわらない。ただし中心はプログラム。
私的なことや妄想はmixi。

ぼちぼちやっていきます。フィード購読してね！

1	p	p²	...	p^a
q	p * q	p² * q		p^a * q
q²	p * q²	p² * q²		p^a * q²
...
q^b	p * q^b	p² * q^b		p^a * q^b

僕のIT革命

「Perlにもしあったらいいなぁと思う機能」は大体Perl6にあると思う

背景

1. ダブルクォーテーションの中で関数が展開できる機能

2. メソッドにおけるオブジェクトの名前

3. データを簡単にダンプする標準関数

4. ファイルの内容を一度に読み込むモジュール

5. Mojo::Base程度の小さなクラスビルダー

6. Net::FTPのコマンドが失敗したときは自動的に例外を投げてほしい

7. ハッシュスライスと配列スライスのための関数

8. Perlの最新の機能とstrictとwarningsとutf8とautodieをレキシカルに有効にするプラグマ

9. 複数行コメント

SEE ALSO

部分継続チュートリアル

この文書について

本文

脚注

実装

BrainMac

Perl 5 to 6 - カリー化

NAME

SYNOPSIS

DESCRIPTION

assumingによるカリー化

Whatever-Starによるカリー化

MOTIVATION

SEE ALSO

Perl 5 to 6 - 一般的なPerl6データ処理イディオム

NAME

SYNOPSIS

DESCRIPTION

ハッシュ

数値

デバッグ

ソート

必須アトリビュート

MOTIVATION

Perl 5 to 6 - 例外と制御例外

NAME

SYNOPSIS

DESCRIPTION

投げられない例外

MOTIVATION

Perl 5 to 6 - 交差メタ演算子

NAME

SYNOPSIS

DESCRIPTION

MOTIVATION

SEE ALSO

Perl 5 to 6 - 縮約メタ演算子

NAME

SYNOPSIS

DESCRIPTION

部分結果の取得

MOTIVATION

SEE ALSO

Perl 5 to 6 - クォートと構文解析

NAME

SYNOPSIS

DESCRIPTION

クォート

構文解析

MOTIVATION

SEE ALSO

Perl 5 to 6 - 派生型

NAME

SYNOPSIS

DESCRIPTION

MOTIVATION

Perl 5 to 6 - (似非)XMLのグラマー

NAME

SYNOPSIS

DESCRIPTION

XMLの概念

グラマーの開発

さらなるハッキング

MOTIVATION

SEE ALSO

Perl 5 to 6 - 正規表現の逆襲

NAME

`assuming`によるカリー化