Perl 6 Solutions for code-golf.io

perl-6-code-golf-io.p6

# NOTE: EACH SOLUTION IS SELF CONTAINED.
# This file can't be run as a script because the trailing semi-colon is left off of each solution.

# Divisors
{(1…$_).grep($_%%*).put}for 1…Ⅽ

# Emirp Numbers
$_≠.flip&&($_,.flip)».is-prime.all&&.say for ^Ⅿ

# Evil Numbers
.base(2).comb(~1)%2||.say for ^Ⅼ

# Fibonacci
(0,1,*+*…*)[^㉛]».say

# Fizz Buzz
say ("Fizz"if $_%%3)~("Buzz"if $_%%5)||$_ for 1…Ⅽ

# Happy Numbers
{my ($n,@s)=$_;while $n≠1&&$n∉@s {@s.push($n);$n=[+] $n.comb»²};$n≠1||.say}for ^𐄚

# Odious Numbers
.base(2).comb(~1)%2&&.say for ^51

# Pascal's Triangle
.put for 1,{|$_,0 Z+0,|$_}…⑳

# Pernicious Numbers
.base(2).comb(~1).is-prime&&.say for 0…Ⅼ

# Prime Numbers
.is-prime&&.say for ^௱

# Quine (Need a new line at the end of the code for it to work)
my &f={say $^s,$^s.perl};f "my \&f=\{say \$^s,\$^s.perl};f "


# 12 Days of Christmas
say <First Second Third Fourth Fifth Sixth Seventh Eighth Ninth Tenth Eleventh Twelfth>.kv.map({$^k;“On the $^v day of Christmas
My true love sent to me
{["A Partridge in a Pear Tree","Two Turtle Doves","Three French Hens","Four Calling Birds","Five Gold Rings","Six Geese-a-Laying","Seven Swans-a-Swimming","Eight Maids-a-Milking","Nine Ladies Dancing","Ten Lords-a-Leaping","Eleven Pipers Piping","Twelve Drummers Drumming"][0…$k].reverse.join(“,
”)}.”.subst(',',', and',:nth(*))}).join("

")

# 99 bottles of Beer
my (\o,&b)="on the wall",{"{$_>0??$_!!'No more'} bottle{'s' if $_≠1} of beer"};say "&b($_) {o}, {b $_.lc}.
Take one down and pass it around, {b($_-1).lc} {o}.
"for 99…1;say "{b} {o}, {b.lc}.
Go to the store and buy some more, &b(99) {o}."

# Christmas Trees
(3…9).map(->$n {(1…$n).map({' 'x$n-$_+1~'*'x($_-1)*2+1}).join("
")~"
"~' 'x$n~"*
"})».say

# Pangram Grep
'a'..'z'⊆.lc.comb&&.say for @*ARGS

# Seven Segment
->$i {say [~] @*ARGS.comb».&{substr [" _ | ||_|","     |  |"," _  _||_ "," _  _| _|","   |_|  |"," _ |_  _|"," _ |_ |_|"," _   |  |"," _ |_||_|"," _ |_| _|"][$_],$i*3,3}}for ^3

# Sierpiński Triangle
my ($s,@d)=' ','▲';{@d=|($s X~@d X~$s),|@d».&{"$_ $_"};$s~=$s}for ^4;@d».say

# π / Pi
sub t(&n,&sa,&p,&c,$z is copy,\x){gather loop {$z=sa($z,my \y=n($z))??p($z,take y)!!c($z,x[(state $)++])}}
sub e([\q,\r,\s,\t],\x){(q*x+r)div (s*x+t)}
sub c([\q,\r,\s,\t],[\u,\v,\w,\x]){[q*u+r*w,q*v+r*x,s*u+t*w,s*v+t*x]}
my \p:=t ->\z {e(z,3)},->\z,\n {n==e(z,4)},->\z,\n {c([10,-10*n,0,1],z)},&c,<1 0 0 1>,(1…*).map: {[$_,4*$_+2,0,2*$_+1]};
say p[0],'.',p[1…Ⅿ].join

# e / Euler's number
my ($r,$f)=2,1.FatRat;$r+=1/($f*=$_)for 2…450;$r.chop(2).say

# Arabic to Roman
my \x=<1 I 5 V 10 X 50 L 100 C 500 D 1000 M>.Hash;sub r($n){for 1000,100,500,100,100,10,50,10,10,1,5,1,1,0 {$n≥$^c&&return x{$^c}~r($n-$^c);$n≥$^c-$^m&&return x{$^m}~r($n+$^m)}}
@*ARGS».&r».say

# Roman to Arabic
@*ARGS».&{say [+] gather $_~~/^[|M{take 1000}|CM{take 900}|D{take 500}|CD{take 400}|C{take 100}|XC{take 90}|L{take 50}|XL{take 40}|X{take 10}|IX{take 9}|V{take 5}|IV{take 4}|I{take 1}]+$/}

# Spelling Numbers
my \o=<_ one two three four five six seven eight nine>;my &l={do given +$_ {when Ⅿ {'one thousand'}
when 0 {'zero'}
when *≤9 {o[$_]}
when *≤⑲ {<ten eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen>[$_-⑩]}
when * <Ⅽ {<twenty thirty forty fifty sixty seventy eighty ninety>[$_/⑩-2]~("-"~o[$_%⑩] if $_%⑩)}
when * {my $a=l($_%Ⅽ);"{o[$_/Ⅽ]} hundred{“ and $a” if $a}"}}}
@*ARGS».&l».say

Great solutions!

I thought it would be a nice touch to use Roman unicode in "Arabic to Roman" (saves 15 characters) and "Roman to Arabic" (saves 10 characters)

my \x=<1 I 5 V 10 X 50 L 100 C 500 D 1000 M>.Hash;sub r($n){for Ⅿ,Ⅽ,Ⅾ,Ⅽ,Ⅽ,Ⅹ,Ⅼ,Ⅹ,Ⅹ,1,5,1,1,0 {$n≥$^c&&return x{$^c}~r($n-$^c);$n≥$^c-$^m&&return x{$^m}~r($n+$^m)}}
@*ARGS».&r».say

@*ARGS».&{say [+] gather $_~~/^[|M{take Ⅿ}|CM{take 900}|D{take Ⅾ}|CD{take 400}|C{take Ⅽ}|XC{take 90}|L{take Ⅼ}|XL{take 40}|X{take Ⅹ}|IX{take 9}|V{take 5}|IV{take 4}|I{take 1}]+$/}