0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

Perl 6Advent Calendar 2017

Day 22

12 Days of Christmasに挑戦

Posted at

こんにちは、22日目の投稿になります。

12月なので12 Days of Christmasを解いていきたいと思います。

12 Days of Christmasとは何でしょうか?浅学にして知らなかったです。
Wikipediaによると結構有名なやつみたいですね:
https://ja.wikipedia.org/wiki/クリスマスの12日間

今回のお題は『クリスマスの12日間』の歌詞をいかに短いコードで出力するかという問題です。

ベースライン

とりあえずベースラインとしてヒアドキュメントで全部出力してみましょう:

say q:to/END/;
On the First day of Christmas
My true love sent to me
A Partridge in a Pear Tree.

On the Second day of Christmas
My true love sent to me
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Third day of Christmas
My true love sent to me
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Fourth day of Christmas
My true love sent to me
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Fifth day of Christmas
My true love sent to me
Five Gold Rings,
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Sixth day of Christmas
My true love sent to me
Six Geese-a-Laying,
Five Gold Rings,
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Seventh day of Christmas
My true love sent to me
Seven Swans-a-Swimming,
Six Geese-a-Laying,
Five Gold Rings,
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Eighth day of Christmas
My true love sent to me
Eight Maids-a-Milking,
Seven Swans-a-Swimming,
Six Geese-a-Laying,
Five Gold Rings,
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Ninth day of Christmas
My true love sent to me
Nine Ladies Dancing,
Eight Maids-a-Milking,
Seven Swans-a-Swimming,
Six Geese-a-Laying,
Five Gold Rings,
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Tenth day of Christmas
My true love sent to me
Ten Lords-a-Leaping,
Nine Ladies Dancing,
Eight Maids-a-Milking,
Seven Swans-a-Swimming,
Six Geese-a-Laying,
Five Gold Rings,
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Eleventh day of Christmas
My true love sent to me
Eleven Pipers Piping,
Ten Lords-a-Leaping,
Nine Ladies Dancing,
Eight Maids-a-Milking,
Seven Swans-a-Swimming,
Six Geese-a-Laying,
Five Gold Rings,
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.

On the Twelfth day of Christmas
My true love sent to me
Twelve Drummers Drumming,
Eleven Pipers Piping,
Ten Lords-a-Leaping,
Nine Ladies Dancing,
Eight Maids-a-Milking,
Seven Swans-a-Swimming,
Six Geese-a-Laying,
Five Gold Rings,
Four Calling Birds,
Three French Hens,
Two Turtle Doves, and
A Partridge in a Pear Tree.
END

作戦

  • 単語の重複が多そう
  • 単語 -> 生起位置A, 生起位置B, ... なkey-valueのリストに変換して持つと圧縮されるかも
  • 最後にあらかじめ圧縮されたやつを復号化してから出力するといいかも

作戦実行

  • 圧縮
my $pos = 0;

my %dict = gather for $text.trans("\n" => "^").split(" ") -> $word {
    POST {
        $pos += $word.chars + 1
    }
    take ($word, $pos)
}.classify({ .[0] }, :as({ .[1] }));

.say for gather for %dict -> (:$key, :$value) {
    take ($key, $value.map(*.base(16)).join(" ")).join("\t")
}
  • 文字-位置リスト結果(※)
me^A    33
Calling 175 216 2CB 39A 47F 578 686 7AD 8ED
Gold    205 2BA 389 46E 567 675 79C 8DC
a       45 AF 12B 1BC 25D 312 3E1 4C6 5BF 6CD 7F4 934
day     D 61 CA 147 1D7 278 32F 3FD 4E1 5DA 6EB 811
me^Five 1FD
Ninth   4DB
Pear    47 B1 12D 1BE 25F 314 3E3 4C8 5C1 6CF 7F6 936
of      11 65 CE 14B 1DB 27C 333 401 4E5 5DE 6EF 815
sent    2B 7F E8 165 1F5 296 34D 41B 4FF 5F8 709 82F
Seventh 327
Piping,^Ten     722 862
Rings,^Four     20A 2BF 38E 473 56C 67A 7A1 8E1
me^Two  87
Birds,^Three    17D 21E 2D3 3A2 487 580 68E 7B5 8F5
Tenth   5D4
Eleventh        6E2
Tree.^^On       4C B6 132 1C3 264 319 3E8 4CD 5C6 6D4 7FB
and^A   9C 118 1A9 24A 2FF 3CE 4B3 5AC 6BA 7E1 921
First   7
Doves,  95 111 1A2 243 2F8 3C7 4AC 5A5 6B3 7DA 91A
Hens,^Two       100 191 232 2E7 3B6 49B 594 6A2 7C9 909
On      0
Ladies  50F 61D 744 884
me^Twelve       837
Maids-a-Milking,^Seven  42C 525 633 75A 89A
Drumming,^Eleven        84A
Partridge       38 A2 11E 1AF 250 305 3D4 4B9 5B2 6C0 7E7 927
in      42 AC 128 1B9 25A 30F 3DE 4C3 5BC 6CA 7F1 931
Twelfth 809
Christmas^My    14 68 D1 14E 1DE 27F 336 404 4E8 5E1 6F2 818
me^Three        F0
me^Seven        355
me^Four 16D
me^Six  29E
Geese-a-Laying,^Five    2A5 374 459 552 660 787 8C7
me^Nine 507
Sixth   272
Swans-a-Swimming,^Six   35E 443 53C 64A 771 8B1
Turtle  8E 10A 19B 23C 2F1 3C0 4A5 59E 6AC 7D3 913
Fourth  140
true    21 75 DE 15B 1EB 28C 343 411 4F5 5EE 6FF 825
to      30 84 ED 16A 1FA 29B 352 420 504 5FD 70E 834
Second  5A
Eighth  3F6
Lords-a-Leaping,^Nine   607 72E 86E
Fifth   1D1
Third   C4
Drummers        841
French  F9 18A 22B 2E0 3AF 494 58D 69B 7C2 902
Tree.^  93B
me^Eight        423
me^Eleven       711
Dancing,^Eight  516 624 74B 88B
love    26 7A E3 160 1F0 291 348 416 4FA 5F3 704 82A
me^Ten  600
Pipers  71B 85B
the     3 56 C0 13C 1CD 26E 323 3F2 4D7 5D0 6DE 805
  • 復号
my @buffer;
my @lines = $text.split("\n", :skip-empty);
for @lines -> $line {
    my ($word, $pos-list) = $line.split("\t");
    for $pos-list.split(" ") {
        my $pos = :16($_);
        for $word.comb {
            @buffer[$pos++] = do if $_ eq '^' {
                "\n"
            } else {
                $_
            }
        }
    }
}

for @buffer { print $_.defined ?? $_ !! " " }                     

.oO( フロントコーディングとか、Re-Pairとかやりたかった・・・)

以上、22日目の投稿でした

※ 著者は27:00現在疲れて死にそうなのでタブがスペースになるのを直す気力がないです。また、バイト数も測れてないです。本当にすみません。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?