diff options
| author | arnesom <arne@bbop.org> | 2023-07-26 23:30:43 +0200 |
|---|---|---|
| committer | arnesom <arne@bbop.org> | 2023-07-26 23:30:43 +0200 |
| commit | 67e911ed0b3264f81846bf64df01f87322f57e3e (patch) | |
| tree | cf8d55df3c54ec21b5ee949e553f0ac9df58e8ad | |
| parent | 5af09e3541ee7a056e1caa1a037ba8e9076d5fc2 (diff) | |
| download | perlweeklychallenge-club-67e911ed0b3264f81846bf64df01f87322f57e3e.tar.gz perlweeklychallenge-club-67e911ed0b3264f81846bf64df01f87322f57e3e.tar.bz2 perlweeklychallenge-club-67e911ed0b3264f81846bf64df01f87322f57e3e.zip | |
Arne Sommer
| -rw-r--r-- | challenge-227/arne-sommer/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-227/arne-sommer/raku/ch-1.raku | 5 | ||||
| -rwxr-xr-x | challenge-227/arne-sommer/raku/ch-2.raku | 22 | ||||
| -rwxr-xr-x | challenge-227/arne-sommer/raku/friday-13th | 17 | ||||
| -rwxr-xr-x | challenge-227/arne-sommer/raku/friday-13th-grep | 5 | ||||
| -rw-r--r-- | challenge-227/arne-sommer/raku/lib/Number/Roman.rakumod | 60 | ||||
| -rwxr-xr-x | challenge-227/arne-sommer/raku/roman-maths | 22 |
7 files changed, 132 insertions, 0 deletions
diff --git a/challenge-227/arne-sommer/blog.txt b/challenge-227/arne-sommer/blog.txt new file mode 100644 index 0000000000..1f0fed48d2 --- /dev/null +++ b/challenge-227/arne-sommer/blog.txt @@ -0,0 +1 @@ +https://raku-musings.com/13th-roman.html diff --git a/challenge-227/arne-sommer/raku/ch-1.raku b/challenge-227/arne-sommer/raku/ch-1.raku new file mode 100755 index 0000000000..28e1f87ba3 --- /dev/null +++ b/challenge-227/arne-sommer/raku/ch-1.raku @@ -0,0 +1,5 @@ +#! /usr/bin/env raku + +unit sub MAIN (Int $year where 1753 <= $year <= 9999 = Date.today.year); + +say (1 .. 12).grep({Date.new(year => $year, month => $_, day => 13).day-of-week == 5 }).elems; diff --git a/challenge-227/arne-sommer/raku/ch-2.raku b/challenge-227/arne-sommer/raku/ch-2.raku new file mode 100755 index 0000000000..5e2f623e8e --- /dev/null +++ b/challenge-227/arne-sommer/raku/ch-2.raku @@ -0,0 +1,22 @@ +#! /usr/bin/env raku + +use lib "lib"; + +use Number::Roman :to, :from; + +unit sub MAIN (Str $first, Str $operator, Str $second); + +my $f = from-roman($first); +my $s = from-roman($second); + +given $operator +{ + when '+' { say to-roman($f + $s) }; + when '-' { say to-roman($f - $s) }; + when 'x' { say to-roman($f * $s) }; + when '*' { say to-roman($f * $s) }; + when 'xx' { say to-roman($f ** $s) }; + when '**' { say to-roman($f ** $s) }; + when '/' { say to-roman($f / $s) }; + default { die "unknown operator"; } +} diff --git a/challenge-227/arne-sommer/raku/friday-13th b/challenge-227/arne-sommer/raku/friday-13th new file mode 100755 index 0000000000..510fc0fe8a --- /dev/null +++ b/challenge-227/arne-sommer/raku/friday-13th @@ -0,0 +1,17 @@ +#! /usr/bin/env raku + +unit sub MAIN (Int $year where 1753 <= $year <= 9999 = Date.today.year, :v(:$verbose)); + +my $fridays = 0; + +for 1 .. 12 -> $month +{ + my $date = Date.new(year => $year, month => $month, day => 13); + my $is-friday = $date.day-of-week == 5; + + $fridays++ if $is-friday; + + say ": $date { $is-friday ?? " Friday" !! ""}" if $verbose; +} + +say $fridays; diff --git a/challenge-227/arne-sommer/raku/friday-13th-grep b/challenge-227/arne-sommer/raku/friday-13th-grep new file mode 100755 index 0000000000..28e1f87ba3 --- /dev/null +++ b/challenge-227/arne-sommer/raku/friday-13th-grep @@ -0,0 +1,5 @@ +#! /usr/bin/env raku + +unit sub MAIN (Int $year where 1753 <= $year <= 9999 = Date.today.year); + +say (1 .. 12).grep({Date.new(year => $year, month => $_, day => 13).day-of-week == 5 }).elems; diff --git a/challenge-227/arne-sommer/raku/lib/Number/Roman.rakumod b/challenge-227/arne-sommer/raku/lib/Number/Roman.rakumod new file mode 100644 index 0000000000..e40e36dd1e --- /dev/null +++ b/challenge-227/arne-sommer/raku/lib/Number/Roman.rakumod @@ -0,0 +1,60 @@ +unit module Number::Roman; + +our sub to-roman (Numeric $number is copy) is export(:to) +{ + return "nulla" if $number == 0; + return "non potest" unless 0 < $number < 3999; + return "non potest" unless $number.Int == $number; + + my $string = ""; + + while $number >= 1000 { $string ~= "M"; $number -= 1000; } + if $number >= 900 { $string ~= "CM"; $number -= 900; } + if $number >= 500 { $string ~= "D"; $number -= 500; } + if $number >= 400 { $string ~= "CD"; $number -= 400; } + while $number >= 100 { $string ~= "C"; $number -= 100; } + if $number >= 90 { $string ~= "XC"; $number -= 90; } + if $number >= 50 { $string ~= "L"; $number -= 50; } + if $number >= 40 { $string ~= "XL"; $number -= 40; } + while $number >= 10 { $string ~= "X"; $number -= 10; } + if $number >= 9 { $string ~= "IX"; $number -= 9; } + if $number >= 5 { $string ~= "V"; $number -= 5; } + if $number >= 4 { $string ~= "IV"; $number -= 4; } + while $number >= 1 { $string ~= "I"; $number -= 1; } + + return $string; +} + +my %value = (I => 1, V => 5, X => 10, L => 50, C => 100, D => 500, M => 1000); + +my Set $valid-roman = %value.keys.Set; + +my $current-value = Inf; + +our sub from-roman (Str $roman) is export(:from) +{ + my @digits = $roman.comb; + + die "Non-Roman digit $_ detected." unless $valid-roman{$_} for @digits; + + my $number = 0; + + while @digits + { + my $current = @digits.shift; + + if @digits.elems + { + if %value{@digits[0]} > %value{$current} + { + $number += %value{@digits.shift} - %value{$current}; + next; + } + } + $number += %value{$current}; + } + + return to-roman($number) eq $roman + ?? $number + !! die "Not a valid Roman Number: $roman"; +} diff --git a/challenge-227/arne-sommer/raku/roman-maths b/challenge-227/arne-sommer/raku/roman-maths new file mode 100755 index 0000000000..5e2f623e8e --- /dev/null +++ b/challenge-227/arne-sommer/raku/roman-maths @@ -0,0 +1,22 @@ +#! /usr/bin/env raku + +use lib "lib"; + +use Number::Roman :to, :from; + +unit sub MAIN (Str $first, Str $operator, Str $second); + +my $f = from-roman($first); +my $s = from-roman($second); + +given $operator +{ + when '+' { say to-roman($f + $s) }; + when '-' { say to-roman($f - $s) }; + when 'x' { say to-roman($f * $s) }; + when '*' { say to-roman($f * $s) }; + when 'xx' { say to-roman($f ** $s) }; + when '**' { say to-roman($f ** $s) }; + when '/' { say to-roman($f / $s) }; + default { die "unknown operator"; } +} |
