mcreenan · July 28, 2021 02:33 · elisherer · Apr 19, 2019
diff --git a/perl-6-code-golf-io.p6 b/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
	# 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 [" _ \| \|\|_\|"," \| \|"," _ _\|\|_ "," _ _\| _\|"," \|_\| \|"," _ \|_ _\|"," _ \|_ \|_\|"," _ \| \|"," _ \|_\|\|_\|"," _ \|_\| _\|"][$_],$i3,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){(qx+r)div (sx+t)}
	sub c([\q,\r,\s,\t],[\u,\v,\w,\x]){[qu+rw,qv+rx,su+tw,sv+tx]}
	my \p:=t ->\z {e(z,3)},->\z,\n {n==e(z,4)},->\z,\n {c([10,-10n,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