開発環境
- macOS Sierra - Apple (OS)
- Emacs (Text Editor)
- Perl 6 (プログラミング言語)
- Rakudo(コンパイラ、実装)
Think Perl 6: How to Think Like a Computer Scientist (Laurent Rosenfeld(著)、Allen B. Downey(著)、Oreilly & Associates Inc)のPart 1(Starting with the basics)、Chapter 11(Case Study: Data Structure Selection)の Building the Huffman Code、Exercise 11-9: Huffman coding of a DNA:1、2、3、4.を取り組んでみる。
Exercise 11-9: Huffman coding of a DNA:1、2、3、4.
コード(Emacs)
#!/usr/bin/env perl6 # -*- coding: utf-8 -*- say '1.'; my $dna = 'CCTATCCTCGACTCCAGTCCA'; my $frequency = bag $dna.comb; my @frequency; for sort {$frequency{$_}}, $frequency.keys { push @frequency, $_ => $frequency{$_}; } say @frequency; my %huffman-tree; while @frequency > 2 { say %huffman-tree; say @frequency; my $letter1 = shift @frequency; my $letter2 = shift @frequency; my $t = $letter1.key ~ $letter2.key; %huffman-tree{$letter1.key} = "[$t]."; %huffman-tree{$letter2.key} = "[$t]-"; my $pair = $t => $letter1.value + $letter2.value; push @frequency, $pair; @frequency = sort {$_.value}, @frequency; } my $letter1 = shift @frequency; my $letter2 = shift @frequency; %huffman-tree{$letter1.key} = "."; %huffman-tree{$letter2.key} = "-"; say %huffman-tree; say @frequency; my %huffman-code; for grep {$_.chars === 1}, %huffman-tree.keys -> $letter { my $result = ''; my $val = %huffman-tree{$letter}; while $val.chars > 1 { my @val = $val.comb; $result = @val[@val.end] ~ $result; $val = %huffman-tree{@val[1..@val.end - 2].join}; } %huffman-code{$letter} = $val ~ $result; } say %huffman-code; say '2.'; my $s = 'think perl 6, think python, think'; $frequency = bag $s.comb; @frequency = (); for sort {$frequency{$_}}, $frequency.keys { push @frequency, $_ => $frequency{$_}; } say @frequency; %huffman-tree = (); while @frequency > 2 { say %huffman-tree; say @frequency; my $letter1 = shift @frequency; my $letter2 = shift @frequency; my $t = $letter1.key ~ $letter2.key; %huffman-tree{$letter1.key} = "[$t]."; %huffman-tree{$letter2.key} = "[$t]-"; my $pair = $t => $letter1.value + $letter2.value; push @frequency, $pair; @frequency = sort {$_.value}, @frequency; } $letter1 = shift @frequency; $letter2 = shift @frequency; %huffman-tree{$letter1.key} = "."; %huffman-tree{$letter2.key} = "-"; say %huffman-tree; say @frequency; %huffman-code = (); for grep {$_.chars === 1}, %huffman-tree.keys -> $letter { my $result = ''; my $val = %huffman-tree{$letter}; while $val.chars > 1 { my @val = $val.comb; $result = @val[@val.end] ~ $result; $val = %huffman-tree{@val[1..@val.end - 2].join}; } %huffman-code{$letter} = $val ~ $result; } say %huffman-code; dd %huffman-code; say '3.'; my $filename = 'the_gold_bug.txt'; $s = $filename.IO.lines.pick(10).join(' '); $frequency = bag $s.comb; @frequency = (); for sort {$frequency{$_}}, $frequency.keys { push @frequency, $_ => $frequency{$_}; } %huffman-tree = (); while @frequency > 2 { my $letter1 = shift @frequency; my $letter2 = shift @frequency; my $t = $letter1.key ~ $letter2.key; %huffman-tree{$letter1.key} = "[$t]."; %huffman-tree{$letter2.key} = "[$t]-"; my $pair = $t => $letter1.value + $letter2.value; push @frequency, $pair; @frequency = sort {$_.value}, @frequency; } $letter1 = shift @frequency; $letter2 = shift @frequency; %huffman-tree{$letter1.key} = "."; %huffman-tree{$letter2.key} = "-"; my %huffman-table = (); for grep {$_.chars === 1}, %huffman-tree.keys -> $letter { my $result = ''; my $val = %huffman-tree{$letter}; while $val.chars > 1 { my @val = $val.comb; $result = @val[@val.end] ~ $result; $val = %huffman-tree{@val[1..@val.end - 2].join}; } %huffman-table{$letter} = $val ~ $result; } for %huffman-table.pick(10) { say $_; } sub encode-morse-huffuman-table($s, %huffman-table) { my $result = ''; for $s.comb -> $letter { $result ~= %huffman-table{$letter}; } return $result; } my $encoded = encode-morse-huffuman-table($s, %huffman-table); say '4.'; sub decode-morse-huffman-table($s, %huffman-table) { my %table = map {%huffman-table{$_} => $_}, %huffman-table.keys; my $result = ''; my $morse = ''; for $s.comb -> $letter { $morse ~= $letter; if %table{$morse}.defined { $result ~= %table{$morse}; $morse = ''; } } return $result; } my $decoded = decode-morse-huffman-table($encoded, %huffman-table); say $decoded eq $s;
入出力結果(Terminal, REPL)
$ ./sample9.pl 1. [G => 2 A => 4 T => 5 C => 10] {} [G => 2 A => 4 T => 5 C => 10] {A => [GA]-, G => [GA].} [T => 5 GA => 6 C => 10] {A => [GA]-, C => ., G => [GA]., GA => [TGA]-, T => [TGA]., TGA => -} [] {A => ---, C => ., G => --., T => -.} 2. [e => 1 l => 1 o => 1 y => 1 6 => 1 r => 1 , => 2 p => 2 k => 3 i => 3 h => 4 n => 4 t => 4 => 5] {} [e => 1 l => 1 o => 1 y => 1 6 => 1 r => 1 , => 2 p => 2 k => 3 i => 3 h => 4 n => 4 t => 4 => 5] {e => [el]., l => [el]-} [o => 1 y => 1 6 => 1 r => 1 , => 2 p => 2 el => 2 k => 3 i => 3 h => 4 n => 4 t => 4 => 5] {e => [el]., l => [el]-, o => [oy]., y => [oy]-} [6 => 1 r => 1 , => 2 p => 2 el => 2 oy => 2 k => 3 i => 3 h => 4 n => 4 t => 4 => 5] {6 => [6r]., e => [el]., l => [el]-, o => [oy]., r => [6r]-, y => [oy]-} [, => 2 p => 2 el => 2 oy => 2 6r => 2 k => 3 i => 3 h => 4 n => 4 t => 4 => 5] {, => [,p]., 6 => [6r]., e => [el]., l => [el]-, o => [oy]., p => [,p]-, r => [6r]-, y => [oy]-} [el => 2 oy => 2 6r => 2 k => 3 i => 3 h => 4 n => 4 t => 4 ,p => 4 => 5] {, => [,p]., 6 => [6r]., e => [el]., el => [eloy]., l => [el]-, o => [oy]., oy => [eloy]-, p => [,p]-, r => [6r]-, y => [oy]-} [6r => 2 k => 3 i => 3 h => 4 n => 4 t => 4 ,p => 4 eloy => 4 => 5] {, => [,p]., 6 => [6r]., 6r => [6rk]., e => [el]., el => [eloy]., k => [6rk]-, l => [el]-, o => [oy]., oy => [eloy]-, p => [,p]-, r => [6r]-, y => [oy]-} [i => 3 h => 4 n => 4 t => 4 ,p => 4 eloy => 4 => 5 6rk => 5] {, => [,p]., 6 => [6r]., 6r => [6rk]., e => [el]., el => [eloy]., h => [ih]-, i => [ih]., k => [6rk]-, l => [el]-, o => [oy]., oy => [eloy]-, p => [,p]-, r => [6r]-, y => [oy]-} [n => 4 t => 4 ,p => 4 eloy => 4 => 5 6rk => 5 ih => 7] {, => [,p]., 6 => [6r]., 6r => [6rk]., e => [el]., el => [eloy]., h => [ih]-, i => [ih]., k => [6rk]-, l => [el]-, n => [nt]., o => [oy]., oy => [eloy]-, p => [,p]-, r => [6r]-, t => [nt]-, y => [oy]-} [,p => 4 eloy => 4 => 5 6rk => 5 ih => 7 nt => 8] {, => [,p]., ,p => [,peloy]., 6 => [6r]., 6r => [6rk]., e => [el]., el => [eloy]., eloy => [,peloy]-, h => [ih]-, i => [ih]., k => [6rk]-, l => [el]-, n => [nt]., o => [oy]., oy => [eloy]-, p => [,p]-, r => [6r]-, t => [nt]-, y => [oy]-} [ => 5 6rk => 5 ih => 7 nt => 8 ,peloy => 8] { => [ 6rk]., , => [,p]., ,p => [,peloy]., 6 => [6r]., 6r => [6rk]., 6rk => [ 6rk]-, e => [el]., el => [eloy]., eloy => [,peloy]-, h => [ih]-, i => [ih]., k => [6rk]-, l => [el]-, n => [nt]., o => [oy]., oy => [eloy]-, p => [,p]-, r => [6r]-, t => [nt]-, y => [oy]-} [ih => 7 nt => 8 ,peloy => 8 6rk => 10] { => [ 6rk]., , => [,p]., ,p => [,peloy]., 6 => [6r]., 6r => [6rk]., 6rk => [ 6rk]-, e => [el]., el => [eloy]., eloy => [,peloy]-, h => [ih]-, i => [ih]., ih => [ihnt]., k => [6rk]-, l => [el]-, n => [nt]., nt => [ihnt]-, o => [oy]., oy => [eloy]-, p => [,p]-, r => [6r]-, t => [nt]-, y => [oy]-} [,peloy => 8 6rk => 10 ihnt => 15] { => [ 6rk]., 6rk => [,peloy 6rk]-, , => [,p]., ,p => [,peloy]., ,peloy => [,peloy 6rk]., ,peloy 6rk => -, 6 => [6r]., 6r => [6rk]., 6rk => [ 6rk]-, e => [el]., el => [eloy]., eloy => [,peloy]-, h => [ih]-, i => [ih]., ih => [ihnt]., ihnt => ., k => [6rk]-, l => [el]-, n => [nt]., nt => [ihnt]-, o => [oy]., oy => [eloy]-, p => [,p]-, r => [6r]-, t => [nt]-, y => [oy]-} [] { => --., , => -..., 6 => ---.., e => -.-.., h => ..-, i => ..., k => ----, l => -.-.-, n => .-., o => -.--., p => -..-, r => ---.-, t => .--, y => -.---} Hash %huffman-code = {" " => "--.", "," => "-...", "6" => "---..", :e("-.-.."), :h("..-"), :i("..."), :k("----"), :l("-.-.-"), :n(".-."), :o("-.--."), :p("-..-"), :r("---.-"), :t(".--"), :y("-.---")} 3. h => -.-.. n => -... , => ...-- I => --.-..-. - => -..-....- e => ..- . => -..-...-- i => .-.. z => -..-...-. b => -.--.- 4. True $
0 コメント:
コメントを投稿