diff options
| author | Jaldhar H. Vyas <jaldhar@braincells.com> | 2023-07-30 16:59:55 -0400 |
|---|---|---|
| committer | Jaldhar H. Vyas <jaldhar@braincells.com> | 2023-07-30 16:59:55 -0400 |
| commit | 7859b44eb6056af0ebc10034b83dad3d20784165 (patch) | |
| tree | e719d72e4e8ea9419da7c460f240360189f9a527 | |
| parent | f84f38be0e67c61c44fa0769b00e53124d1bdde0 (diff) | |
| download | perlweeklychallenge-club-7859b44eb6056af0ebc10034b83dad3d20784165.tar.gz perlweeklychallenge-club-7859b44eb6056af0ebc10034b83dad3d20784165.tar.bz2 perlweeklychallenge-club-7859b44eb6056af0ebc10034b83dad3d20784165.zip | |
Challenge 227 by Jaldhar H. Vyas.
| -rw-r--r-- | challenge-227/jaldhar-h-vyas/blog.txt | 1 | ||||
| -rwxr-xr-x | challenge-227/jaldhar-h-vyas/perl/ch-1.pl | 31 | ||||
| -rwxr-xr-x | challenge-227/jaldhar-h-vyas/perl/ch-2.pl | 129 | ||||
| -rwxr-xr-x | challenge-227/jaldhar-h-vyas/raku/ch-1.raku | 17 | ||||
| -rwxr-xr-x | challenge-227/jaldhar-h-vyas/raku/ch-2.raku | 110 |
5 files changed, 288 insertions, 0 deletions
diff --git a/challenge-227/jaldhar-h-vyas/blog.txt b/challenge-227/jaldhar-h-vyas/blog.txt new file mode 100644 index 0000000000..22952ead79 --- /dev/null +++ b/challenge-227/jaldhar-h-vyas/blog.txt @@ -0,0 +1 @@ +https://www.braincells.com/perl/2023/07/perl_weekly_challenge_week_227.html diff --git a/challenge-227/jaldhar-h-vyas/perl/ch-1.pl b/challenge-227/jaldhar-h-vyas/perl/ch-1.pl new file mode 100755 index 0000000000..5c62ba7683 --- /dev/null +++ b/challenge-227/jaldhar-h-vyas/perl/ch-1.pl @@ -0,0 +1,31 @@ +#!/usr/bin/perl +use 5.030; +use warnings; +use DateTime; +use English; + +sub usage { + print<<"-USAGE-"; +Usage: + $PROGRAM_NAME <year> + + <year> year between 1753 to 9999 +-USAGE- + exit(0); +} + +my $year = shift // usage; +unless ($year >= 1753 && $year <= 9999) { + usage; +} + +my $count = 0; + +for my $month (1 .. 12) { + my $date = DateTime->new(year => $year, month => $month, day => 13); + if ($date->day_of_week == 5) { + $count++; + } +} + +say $count; diff --git a/challenge-227/jaldhar-h-vyas/perl/ch-2.pl b/challenge-227/jaldhar-h-vyas/perl/ch-2.pl new file mode 100755 index 0000000000..2a7e91f9a4 --- /dev/null +++ b/challenge-227/jaldhar-h-vyas/perl/ch-2.pl @@ -0,0 +1,129 @@ +#!/usr/bin/perl +use 5.030; +use warnings; +use experimental qw/ switch /; +use English; + +sub usage { +print STDERR <<"-END-"; +Usage: + $PROGRAM_NAME <arg1> <op> <arg2> + + <arg1> Number in Roman numerals + <op> Arithmetic operation (+, -, *, / or **) + <arg2> Number in Roman numerals +-END- + exit(1); +} + +sub unprefix { + my ($num) = @_; + + my @from = qw/ CM CD XC XL IX IV /; + my @roman = qw/ DCCCC CCCC LXXXX XXXX VIIII IIII /; + + for my $i (0 .. scalar @from - 1) { + $num =~ s/$from[$i]/$roman[$i]/g; + } + + return $num; +} + +sub normalize { + my ($num) = @_; + my @from = qw/ IIIII IIII VV VIV XXXXX XXXX LL LXL CCCCC CCCC DD DCD /; + my @roman = qw/ V IV X IX L XL C XC D CD M CM /; + + for my $i (0 .. scalar @from - 1) { + $num =~ s/$from[$i]/$roman[$i]/g; + } + + return $num; +} + +sub toEnglish { + my ($num) = @_; + my %values = ( + 'M' => 1000, + 'D' => 500, + 'C' => 100, + 'L' => 50, + 'X' => 10, + 'V' => 5, + 'I' => 1, + ); + + my $english = 0; + + for my $digit (split //, unprefix($num)) { + $english += $values{$digit}; + } + + return $english; +} + +sub toRoman { + my ($num) = @_; + my $roman; + + while ($num > 0) { + if ($num >= 1000) { + $roman .= 'M'; + $num -= 1000; + } + elsif ($num >= 500) { + $roman .= 'D'; + $num -= 500; + } + elsif ($num >= 100) { + $roman .= 'C'; + $num -= 100; + } + elsif ($num >= 50) { + $roman .= 'L'; + $num -= 50; + } + elsif ($num >= 10) { + $roman .= 'X'; + $num -= 10; + } + elsif ($num >= 5) { + $roman .= 'V'; + $num -= 5; + } + elsif ($num >= 1) { + $roman .= 'I'; + $num -= 1; + } + } + + return normalize($roman); +} + + +if (scalar @ARGV != 3) { + usage(); +} + +my ($arg1, $op, $arg2) = @ARGV; + +my $val; +my $eng1 = toEnglish($arg1); +my $eng2 = toEnglish($arg2); + +given ($op) { + when ('+') { $val = $eng1 + $eng2; } + when ('-') { $val = $eng1 - $eng2; } + when ('*') { $val = $eng1 * $eng2; } + when ('/') { $val = $eng1 / $eng2; } + when ('**') { $val = $eng1 ** $eng2; } + default { usage; } +} + +given ($val) { + when ($_ == 0) { say 'nulla'; } + when ($_ != int) { say 'non potest'; } + when ($_ <= 0) { say 'non potest'; } + when ($_ >= 4000) { say 'non potest'; } + default { say toRoman($val); } +} diff --git a/challenge-227/jaldhar-h-vyas/raku/ch-1.raku b/challenge-227/jaldhar-h-vyas/raku/ch-1.raku new file mode 100755 index 0000000000..2a0f9bbead --- /dev/null +++ b/challenge-227/jaldhar-h-vyas/raku/ch-1.raku @@ -0,0 +1,17 @@ +#!/usr/bin/raku + + +sub MAIN( + $year where { $_ >= 1753 && $_ <= 9999 } #= year between 1753 to 9999 +) { + my $count = 0; + + for 1 .. 12 -> $month { + my $date = Date.new(year => $year, month => $month, day => 13); + if $date.day-of-week == 5 { + $count++; + } + } + + say $count; +}
\ No newline at end of file diff --git a/challenge-227/jaldhar-h-vyas/raku/ch-2.raku b/challenge-227/jaldhar-h-vyas/raku/ch-2.raku new file mode 100755 index 0000000000..dc8ea1ced1 --- /dev/null +++ b/challenge-227/jaldhar-h-vyas/raku/ch-2.raku @@ -0,0 +1,110 @@ +#!/usr/bin/raku + +sub unprefix(Str $num) { + my $unprefixed = $num; + my @from = qw/ CM CD XC XL IX IV /; + my @to = qw/ DCCCC CCCC LXXXX XXXX VIIII IIII /; + + for 0 ..^ @from.elems -> $i { + $unprefixed = $unprefixed.subst(@from[$i], @to[$i], :g); + } + + return $unprefixed; +} + +sub normalize(Str $num) { + my $normalized = $num; + my @from = qw/ IIIII IIII VV VIV XXXXX XXXX LL LXL CCCCC CCCC DD DCD /; + my @to = qw/ V IV X IX L XL C XC D CD M CM /; + + for 0 .. @from.end -> $i { + $normalized = $normalized.subst(@from[$i], @to[$i], :g); + } + + return $normalized; +} + +sub toEnglish($num) { + my %values = ( + 'M' => 1000, + 'D' => 500, + 'C' => 100, + 'L' => 50, + 'X' => 10, + 'V' => 5, + 'I' => 1, + ); + + my $english = 0; + + for unprefix($num).comb -> $digit { + $english += %values{$digit}; + } + + return $english; +} + +sub toRoman($num is copy) { + my $roman; + + while $num > 0 { + if $num >= 1000 { + $roman ~= 'M'; + $num -= 1000; + } + elsif $num >= 500 { + $roman ~= 'D'; + $num -= 500; + } + elsif $num >= 100 { + $roman ~= 'C'; + $num -= 100; + } + elsif $num >= 50 { + $roman ~= 'L'; + $num -= 50; + } + elsif $num >= 10 { + $roman ~= 'X'; + $num -= 10; + } + elsif $num >= 5 { + $roman ~= 'V'; + $num -= 5; + } + elsif $num >= 1 { + $roman ~= 'I'; + $num -= 1; + } + } + + return normalize($roman); +} + +sub MAIN( + Str $arg1, #= Number in Roman numerals + Str $op, #= Arithmetic operation (+, -, *, / or **) + Str $arg2, #= Number in Roman numerals +) { + my $val; + my $eng1 = toEnglish($arg1); + my $eng2 = toEnglish($arg2); + + given $op { + when '+' { $val = $eng1 + $eng2; } + when '-' { $val = $eng1 - $eng2; } + when '*' { $val = $eng1 * $eng2; } + when '/' { $val = $eng1 / $eng2; } + when '**' { $val = $eng1 ** $eng2; } + default { &*USAGE(); } + } + + given $val { + when $_ == 0 { say 'nulla'; } + when $_ != $_.Int { say 'non potest'; } + when $_ <= 0 { say 'non potest'; } + when $_ >= 4000 { say 'non potest'; } + default { say toRoman($val); } + } + +}
\ No newline at end of file |
