Raku 代码示例
— 焉知非鱼Raku Examples
用类来排序数组 #
有多列数据, 序号, 学校, 课程… 年份这几列。要如果学校和课程相同就根据年份倒序排列。
先按学校排序, 再按课程排序, 然后按年份倒序排序。
我定义一个类来进行多列数据的排序, 很方便：
class Course {
has Int $.numb;
has Str $.univ;
has Str $.dis;
has Int $.paper;
has Int $.cited;
has Int $.year;
}
my @headers = <numb univ dis paper cited year>;
my @courses;
for $=finish.lines -> $line {
next if $line ~~ /^num/;
my @words = $line.words;
@words[0, 3,4,5] = @words[0,3,4,5]».Int;
my %h = @headers Z=> @words;
my $course = Course.new(|%h);
@courses.push($course);
}
my @sorted = @courses.sort(*.univ).sort(*.dis).sort(-*.year);
for @sorted {
say join " ", .numb, .univ, .dis, .paper, .cited, .year;
}
=finish
num univ dis paper cited year
1 Beijing Physics 193 4555 2005
2 Beijing Physics 197 2799 2006
3 Beijing Physics 240 2664 2007
4 Beijing Physics 200 3191 2008
5 Beijing Physics 268 2668 2009
6 Beijing Physics 249 2300 2010
7 Beijing Physics 262 2080 2011
8 Beijing Physics 230 2371 2012
9 Beijing Physics 309 1367 2013
10 Beijing Physics 284 615 2014
11 Beijing Chemistry 143 1650 2005
12 Beijing Chemistry 149 2379 2006
13 Beijing Chemistry 190 2566 2007
14 Beijing Chemistry 147 1888 2008
15 Beijing Chemistry 184 2146 2009
16 Beijing Chemistry 214 2568 2010
17 Beijing Chemistry 238 2874 2011
18 Beijing Chemistry 265 2097 2012
19 Beijing Chemistry 251 1303 2013
20 Beijing Chemistry 241 656 2014
斐波拉契数列（Fibonacci Sequence） #
- analytic
sub fibonacci (Int $n where 0..* --> Int) {
constant phi = (1 + sqrt 5) / 2;
return round( phi**($n+1) / sqrt 5);
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
这种方法计算前1000个斐波拉契数大约为0.746s（2015.7.Rakudo, 以下都是）。
- 迭代
sub fibonacci (Int $n) {
state @sequence = 1,1;
while @sequence.elems <= $n {
@sequence.push( @sequence[*-2] + @sequence[*-1] );
}
return @sequence[$n];
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
这种遍历法大概需要 1 秒多。
- 递归
sub fibonacci (Int $n where 0..*) {
if $n == 0 | 1 {
return 1;
}
else {
return fibonacci($n-1) + fibonacci($n-2);
}
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
比较慢。第 20 个之后越来越慢。
- 递归 - 超运算符
sub fibonacci (Int $n where 0..*) {
if $n == 0 | 1 {
return 1;
}
else {
return [+] ($n-1, $n-2)».&fibonacci;
}
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
和上面差不多。
- 递归 - map
sub fibonacci (Int $n where 0..*) {
if $n == 0 | 1 {
return 1;
}
else {
return [+] map &fibonacci, ($n-1, $n-2);
}
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
同上。
- 递归 - multi
multi fibonacci (0) { 1 }
multi fibonacci (1) { 1 }
multi fibonacci (Int $n --> Int) {
return fibonacci($n-1) + fibonacci($n-2);
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
比上一个稍快。
- 递归 - multi_cached
multi fibonacci (0) { 1 }
multi fibonacci (1) { 1 }
my %cached;
multi fibonacci (Int $n --> Int) {
return %cached{$n} //= fibonacci($n-1) + fibonacci($n-2);
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
花费 0.849s 执行完毕。
- 递归 - multi_cached_state
multi fibonacci (0) { 1 }
multi fibonacci (1) { 1 }
multi fibonacci (Int $n --> Int) {
state %cached;
return %cached{$n} //= fibonacci($n-1) + fibonacci($n-2);
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
花费了 0.885s。
- 递归 - multi_cached_trait
multi fibonacci (0) { 1 }
multi fibonacci (1) { 1 }
multi fibonacci (Int $n --> Int) is cached {
fibonacci($n-1) + fibonacci($n-2);
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
目前报错。
- 序列
sub fibonacci (Int $n) {
constant @sequence := 1, 1, *+* ... *;
return @sequence[$n];
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
花费了 1.6s 多。 其中 := 是惰性赋值。按需求值。
- 序列 - inline
sub fibonacci (Int $n) {
(1, 1, *+* ... *)[$n];
}
for 0..1000 -> $i {
say $i.fmt('%3d'), ': ', fibonacci($i);
}
花费了 133.808s。
排序 #
- bogosort
#! /usr/bin/env raku
sub bogosort ( *@list ) {
until [!after] @list {
@list .= pick(*);
}
return @list;
}
#my @data = 6, 7, 2, 1, 8, 9, 2;
my @data = < p e r l s i x >;
say 'input = ' ~ @data;
say 'output = ' ~ bogosort @data;
输出：
input = p e r l s i x
output = e i l p r s x
[Finished in 1.326s]
- mergesort
#! /usr/bin/env raku
sub merge (@a, @b) {
gather while @a && @b {
if @a[0] before @b[0] { take @a.shift }
else { take @b.shift }
},
@a,
@b;
}
sub mergesort ( *@list ) {
return @list if @list.elems <= 1;
my $middle = @list.elems div 2;
my @left = mergesort @list[ 0 ..^ $middle ];
my @right = mergesort @list[ $middle .. * ];
return merge(@left, @right);
}
# my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
my @data = < p e r l s i x >;
say "input = { @data }";
say "output = { mergesort(@data) }";
输出：
input = p e r l s i x
output = e i l p r s x
[Finished in 0.337s]
- mergesort_functional
#! /usr/bin/env raku
multi merge ([], @ys) { @ys }
multi merge (@xs, []) { @xs }
multi merge ([$x, *@xs], [$y, *@ys]) {
$x before $y ?? ($x, merge @xs, [$y, @ys])
!! ($y, merge [$x, @xs], @ys)
}
multi mergesort ( [] ) { [] }
multi mergesort ([$x]) { [$x] }
multi mergesort (@xs) {
merge
mergesort( @xs[0 ..^ @xs.elems div 2] ),
mergesort( @xs[@xs.elems div 2 .. * ] )
}
my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
#my @data = < p e r l s i x >;
say "input = { @data }";
say "output = { mergesort(@data) }";
输出：
input = 6 7 2 1 8 9 5 3 4
output = 1 2 3 4 5 6 7 8 9
[Finished in 0.373s]
- mergesort_functional_given
#! /usr/bin/env raku
multi merge ([], @ys) { @ys }
multi merge (@xs, []) { @xs }
multi merge ([$x, *@xs], [$y, *@ys]) {
$x before $y ?? ($x, merge @xs, [$y, @ys])
!! ($y, merge [$x, @xs], @ys)
}
multi mergesort ( [] ) { [] }
multi mergesort ([$x]) { [$x] }
multi mergesort (@xs) {
given @xs.elems div 2 -> $middle {
merge
mergesort( @xs[ 0 ..^ $middle ] ),
mergesort( @xs[ $middle .. * ] )
}
}
my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
#my @data = < p e r l s i x >;
say "input = { @data }";
say "output = { mergesort(@data) }";
输出：
input = 6 7 2 1 8 9 5 3 4
output = 1 2 3 4 5 6 7 8 9
[Finished in 0.375s]
- mergesort_functional_interleaved
#! /usr/bin/env raku
multi merge ([], @ys) { @ys }
multi merge (@xs, []) { @xs }
multi merge ([$x, *@xs], [$y, *@ys]) {
$x before $y ?? ($x, merge @xs, [$y, @ys])
!! ($y, merge [$x, @xs], @ys)
}
multi mergesort ( [] ) { [] }
multi mergesort ([$x]) { [$x] }
multi mergesort (@xs) {
merge
mergesort( @xs[0,2...*] ),
mergesort( @xs[1,3...*] )
}
my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
#my @data = < p e r l s i x >;
say "input = { @data }";
say "output = { mergesort(@data) }";
输出：
input = 6 7 2 1 8 9 5 3 4
output = 1 2 3 4 5 6 7 8 9
[Finished in 0.34s]
- quicksort
#! /usr/bin/env raku
sub quicksort( *@list ) {
return @list if @list.elems < 2;
my $pivot = @list.shift;
# my $pivot = @list.=pick(*).shift;
my (@before, @after);
for @list -> $elem {
if $elem before $pivot { @before.push($elem); }
else { @after.push($elem); }
}
return quicksort(@before),
$pivot,
quicksort(@after);
}
#my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
my @data = < p e r l s i x >;
say "input = { @data }";
say "output = { quicksort(@data) }";
输出：
input = p e r l s i x
output = e i l p r s x
[Finished in 0.246s]
- quicksort_classify
#! /usr/bin/env raku
multi quicksort( [] ) { };
multi quicksort( Mu ) { };
multi quicksort( [$x] ) { $x };
multi quicksort( [$pivot, *@xs] ) {
given @xs.classify:{ $^elem before $pivot ?? 'pre' !! 'post'} {
quicksort( .<pre> ),
$pivot,
quicksort( .<post> );
}
}
#my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
my @data = < p e r l s i x >;
say "input = { @data }";
say "output = { quicksort(@data) }";
输出：
input = p e r l s i x
output = e i l p r s x
[Finished in 0.303s]
- quicksort_functional
#! /usr/bin/env raku
multi quicksort( [] ) { };
multi quicksort( [$x] ) { $x };
multi quicksort( [$pivot, *@xs] ) {
quicksort(@xs.grep: * before $pivot),
$pivot,
quicksort(@xs.grep: * !before $pivot);
}
#my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
my @data = < p e r l s i x >;
say "input = { @data }";
say "output = { quicksort(@data) }";
输出:
input = p e r l s i x
output = e i l p r s x
[Finished in 0.27s]
pm 模块 #
首先把自定义的 Bank.pm 模块复制到 Raku 的 lib 目录下：
cp Bank.pm ~/.rakudobrew/moar-nom/install/share/raku/site/lib
Bank.pm
#! /usr/bin/raku
class Ident {
subset Pattern of Str where / \d**3 '-' \d**3 '-' \d**3 /;
has Str $.name = '????';
has Str $.ID where Pattern = '000-000-000';
}
role Taxable [:$THRESHOLD = 100_000] {
constant GENERAL_TAX_RATE = 0.01;
has %.tax_record;
method tax_credits {...}
method calculate_tax () {
my $tax_payable = ($.balance min $THRESHOLD) * GENERAL_TAX_RATE
- $.tax_credits;
%!tax_record{now} = $tax_payable;
return $tax_payable;
}
}
class Account does Taxable {
subset ID of Str where / <alpha>**4 <digit>**5 /;
state ID $next_account_ID = 'AAAA00001';
has Str $.name = die 'Must provide account name';
has Numeric $.balance = 0;
has ID $.ID = $next_account_ID++;
method deposit(Numeric $amount where *>0) {
$!balance += $amount;
}
method withdraw(Numeric $amount where *>0) {
fail "Insufficient funds to withdraw $amount"
if $.balance < $amount;
$!balance -= $amount;
}
method description () {
"$.ID ($.name): balance=$.balance";
}
method tax_credits { 0 }
}
class Bank {
has Ident $!ident handles< name ID >;
has Account %!accounts;
submethod BUILD (|args) {
$!ident .= new(|args);
}
method add_account(Account $account) {
%!accounts{$account.ID} = $account;
}
method close_account(Str $ID) {
return %!accounts{$ID} :delete
// fail "No such account";
}
multi method get_account(Account::ID $ID) {
return %!accounts{$ID} // fail "No such account";
}
multi method get_account(Any $name) {
# return %!accounts.values.grep({.name ~~ $name});
self.for_each_account({.take if .name ~~ $name});
}
method for_each_account (&action_on) {
gather for %!accounts.values -> $account is rw {
action_on($account);
}
}
method collect_taxes () {
self.for_each_account: {
my $tax = .calculate_tax();
.withdraw($tax);
take .ID => $tax;
}
}
method report () {
say "[ {self.ID} [{self.name}] ]"; # Or: say "[ $.ID [$.name] ]";
self.for_each_account(*.description.say);
say '';
}
}
class Account::Corporate
is Account
does Taxable[THRESHOLD => 1_000_000]
{
has Str $.company_ID;
method tax_credits { 5_000 }
method description () {
callsame() ~ " [$.company_ID]";
}
}
该模块的功能是计算银行存款汇率等。下面使用这个模块：
- demo
#! /usr/bin/env raku
use Bank;
my Bank $bank .= new(:ID('123-456-789'));
$bank.add_account: Account.new(:name('Leslie Grace') );
$bank.add_account: Account.new(:name('Dana McKenna'), :balance(10_000));
$bank.add_account: Account.new(:name('AstroDynamic'), :balance( 2e7));
$bank.add_account: Account.new(:name('Jan van Quod'), :balance( 9_999));
$bank.add_account: Account.new(:name('OmniCorp LLC'), :balance( 1e6));
$bank.report;
$bank.get_account('AAAA00003').deposit(100);
$bank.get_account('Jan van Quod')».deposit(2);
$bank.get_account(/D.na/)».deposit(2);
#$bank.get_account(*)».deposit(99);
$bank.report;
given $bank.close_account('AAAA00005') {
say "Closed $^account.perl()\n";
$bank.report;
}
$bank.close_account('ZZZZ99999');
$bank.get_account('AAAA00001').withdraw(1001);
$bank.report;
输出：
[ 123-456-789 [????] ]
AAAA00004 (Jan van Quod): balance=9999
AAAA00001 (Leslie Grace): balance=0
AAAA00005 (OmniCorp LLC): balance=1000000
AAAA00002 (Dana McKenna): balance=10000
AAAA00003 (AstroDynamic): balance=20000000
[ 123-456-789 [????] ]
AAAA00004 (Jan van Quod): balance=10001
AAAA00001 (Leslie Grace): balance=0
AAAA00005 (OmniCorp LLC): balance=1000000
AAAA00002 (Dana McKenna): balance=10002
AAAA00003 (AstroDynamic): balance=20000102
Closed Account.new(name => "OmniCorp LLC", balance => 1000000e0, ID => "AAAA00005", tax_record => {}<>)
[ 123-456-789 [????] ]
AAAA00004 (Jan van Quod): balance=10001
AAAA00001 (Leslie Grace): balance=0
AAAA00002 (Dana McKenna): balance=10002
AAAA00003 (AstroDynamic): balance=20000102
No such account
in method close_account at ~/.rakudobrew/moar-nom/install/share/raku/site/lib/Bank.pm:67
Actually thrown at:
in block <unit> at ~/04.bank_demo.pl:26
[Finished in 0.768s]
- demo_inheritance
#! /usr/bin/env raku
sub show ($text) {
say '';
say ('____/ ' ~ $text ~ ' \_________________________________________________').substr(0,50);
}
use Bank;
my Bank $bank .= new(:ID('123-456-789'), :name('Bank of Evil'));
$bank.add_account: Account.new(:name('Leslie Grace'), :balance( 1_000));
$bank.add_account: Account.new(:name('Dana McKenna'), :balance(10_000));
$bank.add_account: Account.new(:name('Jan van Quod'), :balance( 9_999));
$bank.add_account: Account::Corporate.new(:name('AstroDynamic'), :balance(2e7) :company_ID('ASDY'));
$bank.add_account: Account::Corporate.new(:name('OmniCorp LLC'), :balance(1e6) :company_ID('OMNI'));
show 'Status';
$bank.report;
show 'Taxes collected';
.say for $bank.collect_taxes();
show 'Status';
$bank.report;
$bank.collect_taxes();
show 'Tax records';
$bank.for_each_account({ say .name, ': ', .tax_record });
show 'Culling acounts';
given $bank {
.for_each_account: {
.close_account($^account.ID).say
if $^account.balance < 10_000;
}
}
show 'Status';
$bank.report;
输出：
____/ Status \____________________________________
[ 123-456-789 [Bank of Evil] ]
AAAA00004 (AstroDynamic): balance=20000000 [ASDY]
AAAA00001 (Leslie Grace): balance=1000
AAAA00005 (OmniCorp LLC): balance=1000000 [OMNI]
AAAA00002 (Dana McKenna): balance=10000
AAAA00003 (Jan van Quod): balance=9999
____/ Taxes collected \___________________________
AAAA00004 => 5000
AAAA00001 => 10
AAAA00005 => 5000
AAAA00002 => 100
AAAA00003 => 99.99
____/ Status \____________________________________
[ 123-456-789 [Bank of Evil] ]
AAAA00004 (AstroDynamic): balance=19995000 [ASDY]
AAAA00001 (Leslie Grace): balance=990
AAAA00005 (OmniCorp LLC): balance=995000 [OMNI]
AAAA00002 (Dana McKenna): balance=9900
AAAA00003 (Jan van Quod): balance=9899.01
____/ Tax records \_______________________________
AstroDynamic: Instant:1440413601.447466 => 5000, Instant:1440413601.463112 => 5000
Leslie Grace: Instant:1440413601.450753 => 10, Instant:1440413601.465823 => 9.9
OmniCorp LLC: Instant:1440413601.452933 => 5000, Instant:1440413601.468346 => 4950
Dana McKenna: Instant:1440413601.454860 => 100, Instant:1440413601.470238 => 99
Jan van Quod: Instant:1440413601.457399 => 99.99, Instant:1440413601.471551 => 98.9901
____/ Culling acounts \___________________________
Account.new(name => "Leslie Grace", balance => 980.1, ID => "AAAA00001", tax_record => {"Instant:1440413601.450753" => 10.0, "Instant:1440413601.465823" => 9.9}<>)
Account.new(name => "Dana McKenna", balance => 9801.0, ID => "AAAA00002", tax_record => {"Instant:1440413601.454860" => 100.0, "Instant:1440413601.470238" => 99.0}<>)
Account.new(name => "Jan van Quod", balance => 9800.0199, ID => "AAAA00003", tax_record => {"Instant:1440413601.457399" => 99.99, "Instant:1440413601.471551" => 98.9901}<>)
____/ Status \____________________________________
[ 123-456-789 [Bank of Evil] ]
AAAA00004 (AstroDynamic): balance=19990000 [ASDY]
AAAA00005 (OmniCorp LLC): balance=990050 [OMNI]
[Finished in 0.817s]
- demo_unary_dot
#! /usr/bin/env raku
use Bank;
my Bank $bank .= new(:ID('123-456-789'));
given $bank {
.add_account: Account.new(:name('Leslie Grace'), :balance( 1_000));
.add_account: Account.new(:name('Dana McKenna'), :balance(10_000));
.add_account: Account.new(:name('AstroDynamic'), :balance( 2e7));
.add_account: Account.new(:name('Jan van Quod'), :balance( 9_999));
.add_account: Account.new(:name('OmniCorp LLC'), :balance( 1e6));
.report;
.get_account('AAAA00003').deposit(100);
.report;
say .close_account('AAAA00005');
.report;
.get_account('AAAA00001').withdraw(1001);
.report;
}
输出：
[ 123-456-789 [????] ]
AAAA00004 (Jan van Quod): balance=9999
AAAA00001 (Leslie Grace): balance=1000
AAAA00005 (OmniCorp LLC): balance=1000000
AAAA00002 (Dana McKenna): balance=10000
AAAA00003 (AstroDynamic): balance=20000000
[ 123-456-789 [????] ]
AAAA00004 (Jan van Quod): balance=9999
AAAA00001 (Leslie Grace): balance=1000
AAAA00005 (OmniCorp LLC): balance=1000000
AAAA00002 (Dana McKenna): balance=10000
AAAA00003 (AstroDynamic): balance=20000100
Account.new(name => "OmniCorp LLC", balance => 1000000e0, ID => "AAAA00005", tax_record => {}<>)
[ 123-456-789 [????] ]
AAAA00004 (Jan van Quod): balance=9999
AAAA00001 (Leslie Grace): balance=1000
AAAA00002 (Dana McKenna): balance=10000
AAAA00003 (AstroDynamic): balance=20000100
Insufficient funds to withdraw 1001
in method withdraw at ~/.rakudobrew/moar-nom/install/share/raku/site/lib/Bank.pm:43
in block <unit> at ~04.bank_demo_unary_dot.pl:22
[Finished in 0.738s]
LZW #
LZW 算法:
- demo
#! /usr/bin/env raku
sub compress(Str $uncompressed --> List) {
# Build a look-up table of encoded representations
# (each ASCII char represented by its equivalent codepoint)
my %code_for = map { $^ASCII.chr => $^ASCII }, ^256;
# Loop and collect each encoding...
gather {
# Track which characters we've seen but not yet encoded
my $already_seen = "";
# Walk through each single character...
for $uncompressed.comb -> $next_char {
# Now we've seen that next character as well
my $now_seen = $already_seen ~ $next_char;
# If new char sequence is known, keep looking
if %code_for{$now_seen}:exists {
$already_seen = $now_seen;
}
# Otherwise, we have an unknown sequence of chars
else {
# Emit encoding for what we've previously seen
take %code_for{$already_seen};
# Add encoding for new unknown sequence to table
%code_for{$now_seen} = %code_for.elems;
# Restart the current sequence from this char
$already_seen = $next_char;
}
}
# Emit the encoding for the final sequence (if any)
take %code_for{$already_seen} if $already_seen ne "";
}
}
# Convert to codepoints...
my @codes = compress('To be or not to be. That be the question, matey!');
say @codes;
separator;
# Emit as characters...
say @codes».chr;
separator;
# Convert to a binary sequence...
my $bits_per_code = @codes.max.log(2).ceiling();
my $format = '%0' ~ $bits_per_code ~ 'b';
my $bits = @codes».fmt($format).join;
say $bits;
separator;
say $bits.comb(/.**1..7/).map({:2($^bitpattern).chr}).join;
separator;
sub separator { say '_' x 50 }
输出：
84 111 32 98 101 32 111 114 32 110 111 116 32 116 257 259 46 32 84 104 97 267 259 268 104 260 113 117 101 115 116 105 111 110 44 32 109 276 101 121 33
__________________________________________________
T o b e o r n o t t ā ă . T h a ċ ă Č h Ą q u e s t i o n , m Ĕ e y !
__________________________________________________
001010100001101111000100000001100010001100101000100000001101111001110010000100000001101110001101111001110100000100000001110100100000001100000011000101110000100000001010100001101000001100001100001011100000011100001100001101000100000100001110001001110101001100101001110011001110100001101001001101111001101110000101100000100000001101101100010100001100101001111001000100001
__________________________________________________
x@1 Qo B\7NAt@0\
C aBp 4 CDu'h4Ms8,l(2O
__________________________________________________
[Finished in 0.429s]
- LZW_functional
#! /usr/bin/env raku
# To compress a string...
sub compress(Str $uncompressed) {
# Encode the character list via a dictionary, from the start
encode( $uncompressed.comb, code => hash(map {$^ASCII.chr => $^ASCII}, ^256), seen => "" )
}
# Encode an empty list where nothing already seen as nothing
multi encode([], :%code, :$seen where "") {}
# Encode an empty list where something already seen by look-up
multi encode([], :%code, :$seen) { %code{$seen} }
# Encode an list of one or more uncompressed characters...
multi encode([$next, *@uncompressed], :%code, :$seen) {
# If [already-seen plus next char] is a known sequence...
%code{ $seen~$next }:exists
# Then encode all of that together
?? encode(@uncompressed, :%code, seen => $seen~$next)
# Else emit encoding for the already-seen sequence
!! ( %code{$seen},
# Plus the encoding for the rest of the string...
encode( @uncompressed,
# Add encoding for new sequence to table
code => %( %code, $seen~$next => %code.elems ),
# Continue encoding from next character
seen => $next
)
)
}
# Convert to codepoints...
my @codes = compress('To be or not to be. That be the question, matey!');
say @codes;
separator;
# Emit as characters...
say @codes».chr;
separator;
# Convert to a binary sequence...
my $bits_per_code = @codes.max.log(2).ceiling();
my $format = '%0' ~ $bits_per_code ~ 'b';
my $bits = @codes».fmt($format).join;
say $bits;
separator;
say $bits.comb(/.**1..7/).map({:2($^bitpattern).chr}).join;
separator;
sub separator { say '_' x 50 }
输出：
84 111 32 98 101 32 111 114 32 110 111 116 32 116 257 259 46 32 84 104 97 267 259 268 104 260 113 117 101 115 116 105 111 110 44 32 109 276 101 121 33
__________________________________________________
T o b e o r n o t t ā ă . T h a ċ ă Č h Ą q u e s t i o n , m Ĕ e y !
__________________________________________________
001010100001101111000100000001100010001100101000100000001101111001110010000100000001101110001101111001110100000100000001110100100000001100000011000101110000100000001010100001101000001100001100001011100000011100001100001101000100000100001110001001110101001100101001110011001110100001101001001101111001101110000101100000100000001101101100010100001100101001111001000100001
__________________________________________________
x@1 Qo B\7NAt@0\
C aBp 4 CDu'h4Ms8,l(2O
__________________________________________________
[Finished in 0.658s]
- validation_concurrent
#! /usr/bin/env raku
my @records = (
{ :Name<Damian Conway>, :Age(42), :ID('00012345') },
{ :Name<Leslie Duvall>, :Age(29), :ID('668') },
{ :Name<Sam Georgious>, :Age(-2), :ID('00000007') },
);
sub normalize_data (Hash $record) {
$record<Name> .= subst(/<lower>/,{$<lower>.uc}, :g);
$record<Age> max= 18;
$record<ID> .= fmt('%08d');
}
sub report ($outcome) {
say "\tInvalid record ($outcome)";
}
sub invalid_name ($rec) { "Bad name: $rec" if $rec<Name> !~~ /\S/; }
sub invalid_age ($rec) { "Bad age: $rec" if $rec<Age> < 18; }
sub invalid_ID ($rec) { "Bad ID: $rec" if $rec<ID> !~~ /^\d ** 8$/; }
say 'Validating...';
my @invalidations = (
@records».&invalid_name,
@records».&invalid_age,
@records».&invalid_ID,
);
@invalidations».&report;
say 'Normalizing...';
@records».&normalize_data;
say 'Revalidating...';
@invalidations = (
@records».&invalid_name,
@records».&invalid_age,
@records».&invalid_ID,
);
@invalidations».&report;
输出：
Validating...
postcircumfix:<{ }> not defined for type Str
- validation_imperative
#! /usr/bin/env raku
my @records = (
{ :Name<Damian Conway>, :Age(42), :ID('00012345') },
{ :Name<Leslie Duvall>, :Age(29), :ID('668') },
{ :Name<Sam Georgious>, :Age(-2), :ID('00000007') },
);
sub normalize_data (Hash $record) {
$record<Name> .= subst(/<lower>/,{$<lower>.uc}, :g);
$record<Age> max= 18;
$record<ID> .= fmt('%08d');
}
sub report ($outcome) {
say "\tInvalid record ($outcome)";
}
sub invalid_name ($rec) { "Bad name: $rec" if $rec<Name> !~~ /\S/; }
sub invalid_age ($rec) { "Bad age: $rec" if $rec<Age> < 18; }
sub invalid_ID ($rec) { "Bad ID: $rec" if $rec<ID> !~~ /^\d ** 8$/; }
say 'Validating...';
my @invalidations = gather for @records -> $record {
take invalid_name($record);
take invalid_age($record);
take invalid_ID($record);
}
for @invalidations -> $errmsg {
report( $errmsg );
}
say 'Normalizing...';
for @records -> $record {
normalize_data($record);
}
say 'Revalidating...';
@invalidations = gather for @records -> $record {
take invalid_name($record);
take invalid_age($record);
take invalid_ID($record);
}
for @invalidations -> $errmsg {
report( $errmsg );
}
输出：
Validating...
Invalid record (Bad ID: Name Leslie Duvall Age 29 ID 668)
Invalid record (Bad age: Name Sam Georgious Age -2 ID 00000007)
Normalizing...
Revalidating...
- validation_junctions
#! /usr/bin/env raku
my @records = (
{ :Name<Damian Conway>, :Age(42), :ID('00012345') },
{ :Name<Leslie Duvall>, :Age(29), :ID('668') },
{ :Name<Sam Georgious>, :Age(-2), :ID('00000007') },
);
sub normalize_data (Hash $record) {
$record<Name> .= subst(/<lower>/,{$<lower>.uc}, :g);
$record<Age> max= 18;
$record<ID> .= fmt('%08d');
}
sub report ($outcome) {
say "\tInvalid record ($outcome)";
}
sub invalid_name ($rec) { "Bad name: $rec" if $rec<Name> !~~ /\S/; }
sub invalid_age ($rec) { "Bad age: $rec" if $rec<Age> < 18; }
sub invalid_ID ($rec) { "Bad ID: $rec" if $rec<ID> !~~ /^\d ** 8$/; }
my $invalid_record = &invalid_name | &invalid_age | &invalid_ID;
say 'Validating...';
report( $invalid_record(all @records) );
say 'Normalizing...';
normalize_data(all @records);
say 'Revalidating...';
report( $invalid_record(all @records) );
输出：
Validating...
Invalid record (Bad ID: Name Leslie Duvall Age 29 ID 668)
Invalid record (Bad age: Name Sam Georgious Age -2 ID 00000007)
Normalizing...
Revalidating...
- prime_demo
#! /usr/bin/env raku
sub is_prime(Int $n) {
return $n % all(2..$n.sqrt+1);
}
for 1..1001 -> $n {
say "$n is prime" if is_prime($n);
}
输出：
1 is prime
3 is prime
5 is prime
7 is prime
11 is prime
...
991 is prime
997 is prime
- 统计
#! /usr/bin/env raku
my @values = (1, 1, 3, 4, 4, 4, 4, 5, 5, 5, 7, 7, 12, 12, 1, 7, 7, 99);
say 'mean (a) = ', mean_a(@values);
say 'mean (g) = ', mean_g(@values);
say ' mode = ', mode(@values);
say ' median = ', median(@values);
sub mean_a (*@list) {
([+] @list) / @list.elems;
}
sub mean_g (*@list) {
([*] @list) ** (1/@list.elems);
}
sub mode (*@list) {
given @list.Bag {
.pairs.grep({$^elem.value == .values.max})».key;
}
}
sub median (*@list) {
given @list.sort {
.elems %% 2
?? mean_a( .[*/2-1, */2] )
!! .[*/2];
}
}
输出：
mean (a) = 10.444444
mean (g) = 4.95872541158849
mode = 7 4
median = 5
- stats_hybird
#! /usr/bin/env raku
my @values = (1, 1, 3, 4, 4, 4, 4, 5, 5, 5, 7, 7, 12, 12, 1, 7, 7, 99);
say 'mean (a) = ', mean_a(@values);
say 'mean (g) = ', mean_g(@values);
say ' mode = ', mode(@values);
say ' median = ', median(@values);
sub mean_a (*@list) {
my $sum = [+] @list;
return $sum / @list.elems;
}
sub mean_g (*@list) {
my $product = [*] @list;
return $product ** (1/@list.elems)
}
sub mode (*@list) {
my $frequencies = @list.Bag;
my $list_elems = $frequencies.pairs;
my $max_freq = $frequencies.values.max;
my @max_vals = $list_elems.grep({.value == $max_freq});
return @max_vals».key;
}
sub median (*@list) {
my @sorted = @list.sort;
return @sorted.elems %% 2 ?? mean_a(@sorted.[*/2, */2-1])
!! @sorted.[*/2]
}
输出：
mean (a) = 10.444444
mean (g) = 4.95872541158849
mode = 7 4
median = 5
- stats_imperative
#! /usr/bin/env raku
my @values = (1, 1, 3, 4, 4, 4, 4, 5, 5, 5, 7, 7, 12, 12, 1, 7, 7, 99);
say 'mean (a) = ', mean_a(@values);
say 'mean (g) = ', mean_g(@values);
say ' mode = ', mode(@values);
say ' median = ', median(@values);
sub mean_a (*@list) {
my $sum;
for @list -> $elem {
$sum += $elem;
}
return $sum / @list.elems;
}
sub mean_g (*@list) {
my $product;
for @list -> $elem {
$product *= $elem;
}
return $product ** (1/@list.elems);
}
sub mode (*@list) {
my %counts;
%counts{$_}++ for @list;
my $max = %counts.values.max;
return %counts.grep({ .value == $max })».key;
}
sub median (*@list) {
@list.=sort();
return @list.elems %% 2
?? mean_a( @list[*/2, */2-1] )
!! @list[*/2];
}
输出：
mean (a) = 10.444444
mean (g) = 4.95872541158849
mode = 4 7
median = 5
- stats_mode_func
#! /usr/bin/env raku
my @values = (1, 1, 3, 4, 4, 4, 4, 5, 5, 5, 7, 7, 12, 12, 1, 7, 7, 99);
say 'mean (a) = ', mean_a(@values);
say 'mean (g) = ', mean_g(@values);
say ' mode = ', mode(@values);
say ' median = ', median(@values);
sub mean_a (*@list) {
sub sum { [+] @list }
return sum() / @list.elems;
}
sub mean_g (*@list) {
sub product { [*] @list }
return product() ** (1/@list.elems)
}
sub mode (*@list) {
sub frequencies { @list.Bag }
sub list_elems { frequencies.pairs }
sub max_freq { frequencies.values.max }
sub max_vals { list_elems.grep: {.value == max_freq} }
return max_vals».keys;
}
sub median (*@list) {
sub sorted { @list.sort }
return sorted.elems %% 2
?? mean_a(sorted.[*/2, */2-1])
!! sorted.[*/2]
}
输出：
mean (a) = 10.444444
mean (g) = 4.95872541158849
mode = 7 4
median = 5
- stats_OO
#! /usr/bin/env raku
class StatList is List {
method mean_a () {
sub sum { [+] self }
return sum() / self.elems;
}
method mean_g () {
sub product { [*] self }
return product() ** (1/self.elems)
}
method median () {
sub sorted { self.sort }
return sorted.elems %% 2
?? StatList.new(sorted.[*/2, */2-1]).mean_a()
!! sorted.[*/2];
}
method mode () {
sub frequencies { self.Bag }
sub list_elems { frequencies.pairs }
sub max_freq { frequencies.values.max }
sub max_vals { list_elems.grep: {.value == max_freq} }
return max_vals».keys;
}
}
my $list = StatList.new(1,3,5,8,8,11);
say $list.mean_a;
say $list.mean_g;
say $list.median;
say $list.mode;
输出：
6
4.68393277169202
13
8
以上所有文件都可以在这儿 下载到 - a Raku introductory tutorial by Damian Conway