Skip to content

Commit acee7b8

Browse files
rjt-plrjt-pl
authored
Merge branch 'manwar:master' into master
2 parents 99d2e30 + 9506417 commit acee7b8

37 files changed

+776
-190
lines changed

‎challenge-259/jaldhar-h-vyas/perl/ch-1.pl‎

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
#!/usr/bin/perl
2+
use 5.038;
3+
use warnings;
4+
use DateTime;
5+
use DateTime::Format::Strptime;
6+
7+
my $strptime = DateTime::Format::Strptime->new(
8+
pattern => '%F',
9+
on_error => sub { die "Invalid date\n"; }
10+
);
11+
12+
my $startDate = $strptime->parse_datetime(shift @ARGV);
13+
my $offset = shift @ARGV;
14+
my @bankHolidays = map { $strptime->parse_datetime($_) } @ARGV;
15+
my $endDate = $startDate;
16+
17+
while ($offset > 0 ) {
18+
$endDate->add(days => 1);
19+
my $dow = $endDate->dow;
20+
if ($dow > 0 && $dow < 6 && !grep { $_ == $endDate } @bankHolidays) {
21+
$offset--;
22+
}
23+
}
24+
25+
say $endDate->ymd;

‎challenge-259/jaldhar-h-vyas/perl/ch-2.pl‎

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,60 @@
1+
#!/usr/bin/perl
2+
use 5.038;
3+
use warnings;
4+
use Parse::RecDescent;
5+
6+
# $::RD_TRACE = 1;
7+
8+
my $grammar = <<'-EOT-';
9+
startrule: multi_line | single_line
10+
11+
single_line: '{%' ws identifier field(s) '%}'
12+
{
13+
$return = "{\n"
14+
. " name => $item{identifier},\n"
15+
. " fields => {\n "
16+
. join(",\n ", @{$item{'field(s)'}})
17+
. "\n }\n"
18+
. "}\n";
19+
}
20+
21+
multi_line: '{%' ws identifier field(s) '%}' text '{%' ws "endmyid" ws '%}'
22+
{
23+
$return = "{\n"
24+
. " name => $item{identifier},\n"
25+
. " fields => {\n "
26+
. join(",\n ", @{$item{'field(s)'}})
27+
. "\n },\n"
28+
. " text => $item{text}"
29+
. "}\n";
30+
}
31+
32+
ws: /\s*/
33+
34+
identifier: /\w+/
35+
{
36+
my $id = $item[1];
37+
$return = $id;
38+
}
39+
40+
field: ws name ws '=' ws value
41+
{ $return = "$item{ name } => $item{ value }" }
42+
43+
name: /\w+/
44+
45+
value: number | string
46+
47+
number: /\d+/
48+
{ $return = 0 + $item[1]; }
49+
50+
string: /"/ content /"/
51+
{ $return = $item{content}; }
52+
53+
content: /(\\" | \\\\ | [^"])+/x
54+
55+
text: /[^{]+/
56+
-EOT-
57+
58+
my $parser = Parse::RecDescent->new($grammar);
59+
my $text = shift;
60+
say $parser->startrule($text);

‎challenge-259/jaldhar-h-vyas/raku/ch-1.raku‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
#!/usr/bin/raku
2+
3+
sub MAIN(
4+
$start,
5+
$offset is copy,
6+
*@holidays
7+
) {
8+
my $startDate = Date.new($start);
9+
my @bankHolidays = @holidays.map({ Date.new($_) });
10+
my $endDate = $startDate;
11+
12+
while ($offset > 0 ) {
13+
$endDate += 1;
14+
my $dow = $endDate.day-of-week;
15+
if ($dow > 0 && $dow < 6 && @bankHolidays.none == $endDate) {
16+
$offset--;
17+
}
18+
}
19+
20+
say $endDate.yyyy-mm-dd;
21+
}

‎challenge-259/jaldhar-h-vyas/raku/ch-2.raku‎

Lines changed: 105 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,105 @@
1+
#!/usr/bin/raku
2+
3+
grammar LineParser {
4+
rule TOP {
5+
| <single-line>
6+
| <multi-line>
7+
}
8+
9+
token single-line {
10+
^ '{%' \s+ <identifier> <field>* \s* '%}' $
11+
}
12+
13+
token multi-line {
14+
'{%' \s+ <identifier> <field>* \s* '%}' \n
15+
<text>
16+
'{%' \s+ 'end' <end-id=.identifier> \s* '%}' \n?
17+
}
18+
19+
token identifier { \w+ }
20+
21+
token ws { \h* }
22+
23+
token field {
24+
\s+ <name=.identifier> \s* '=' \s* <value>
25+
}
26+
27+
proto token value {*}
28+
29+
token value:sym<number> { \d+ }
30+
31+
token value:sym<string> {
32+
'"' <content> '"'
33+
}
34+
35+
token content {
36+
[
37+
| <-[\"\\]>+
38+
| '\\"'
39+
| '\\\\'
40+
]*
41+
}
42+
43+
token text {
44+
<-[{]>*
45+
}
46+
}
47+
48+
class LineActions {
49+
method TOP($/) {
50+
make $<single-line> ?? $<single-line>.made !! $<multi-line>.made;
51+
}
52+
53+
method single-line($/) {
54+
make {
55+
name => ~$<identifier>,
56+
fields => $<field>.map({
57+
~$_<name> => $_<value>.made
58+
}).Hash
59+
}
60+
}
61+
62+
method multi-line($/) {
63+
die "Closing tag 'end{$<identifier>}' does not match opening tag '{$<end-id>}'"
64+
unless $<identifier> eq $<end-id>;
65+
66+
make {
67+
name => ~$<identifier>,
68+
fields => $<field>.map({
69+
~$_<name> => $_<value>.made
70+
}).Hash,
71+
text => ~$<text>
72+
}
73+
}
74+
75+
method value:sym<number>($/) { make +$/ }
76+
method value:sym<string>($/) {
77+
make ~$<content>
78+
.subst(/'\\"'/, '"', :g)
79+
.subst(/'\\\\'/, '\\', :g)
80+
}
81+
}
82+
83+
sub prettyprint(%data) {
84+
my $output = "\{\n name => %data<name>,\n fields => \{\n ";
85+
86+
$output ~= %data<fields>
87+
.keys
88+
.map({ "$_ => %data<fields>{$_}" })
89+
.join(",\n ");
90+
91+
92+
$output ~= "\n \},\n";
93+
if %data<text> {
94+
$output ~= " text => %data<text>";
95+
}
96+
$output ~= "}\n";
97+
98+
return $output;
99+
}
100+
101+
sub MAIN($input) {
102+
my $actions = LineActions.new;
103+
my $match = LineParser.parse($input, :$actions);
104+
say $match ?? prettyprint($match.made) !! 'Failed to parse line';
105+
}

‎challenge-341/jeanluc2020/blog-1.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-341-1.html

‎challenge-341/jeanluc2020/blog-2.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
http://gott-gehabt.de/800_wer_wir_sind/thomas/Homepage/Computer/perl/theweeklychallenge-341-2.html

‎challenge-341/jeanluc2020/perl/ch-1.pl‎

Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
#!/usr/bin/env perl
2+
# https://theweeklychallenge.org/blog/perl-weekly-challenge-341/#TASK1
3+
#
4+
# Task 1: Broken Keyboard
5+
# =======================
6+
#
7+
# You are given a string containing English letters only and also you are given
8+
# broken keys.
9+
#
10+
# Write a script to return the total words in the given sentence can be typed
11+
# completely.
12+
#
13+
## Example 1
14+
##
15+
## Input: $str = 'Hello World', @keys = ('d')
16+
## Output: 1
17+
##
18+
## With broken key 'd', we can only type the word 'Hello'.
19+
#
20+
#
21+
## Example 2
22+
##
23+
## Input: $str = 'apple banana cherry', @keys = ('a', 'e')
24+
## Output: 0
25+
#
26+
#
27+
## Example 3
28+
##
29+
## Input: $str = 'Coding is fun', @keys = ()
30+
## Output: 3
31+
##
32+
## No keys broken.
33+
#
34+
#
35+
## Example 4
36+
##
37+
## Input: $str = 'The Weekly Challenge', @keys = ('a','b')
38+
## Output: 2
39+
#
40+
#
41+
## Example 5
42+
##
43+
## Input: $str = 'Perl and Python', @keys = ('p')
44+
## Output: 1
45+
#
46+
############################################################
47+
##
48+
## discussion
49+
##
50+
############################################################
51+
#
52+
# Create a list of the words in $str. Then for each of the words,
53+
# check if any of the characters in the word is a broken key, we remove
54+
# it from the list. Count the remaining words as the result
55+
56+
use v5.36;
57+
58+
59+
broken_keyboard('Hello World', 'd');
60+
broken_keyboard('apple banana cherry', 'a', 'e');
61+
broken_keyboard('Coding is fun' );
62+
broken_keyboard('The Weekly Challenge', 'a','b');
63+
broken_keyboard('Perl and Python', 'p');
64+
65+
sub broken_keyboard($str, @keys) {
66+
say "Input: '$str', (" . join(", ", @keys) . ")";
67+
my @words = split /\s+/, $str;
68+
my $count = scalar(@words);
69+
OUTER:
70+
foreach my $w (@words) {
71+
foreach my $key (@keys) {
72+
if($w =~ m/$key/i) {
73+
$count--;
74+
next OUTER;
75+
}
76+
}
77+
}
78+
say "Output: $count";
79+
}

‎challenge-341/jeanluc2020/perl/ch-2.pl‎

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
#!/usr/bin/env perl
2+
# https://theweeklychallenge.org/blog/perl-weekly-challenge-341/#TASK2
3+
#
4+
# Task 2: Reverse Prefix
5+
# ======================
6+
#
7+
# You are given a string, $str and a character in the given string, $char.
8+
#
9+
# Write a script to reverse the prefix upto the first occurrence of the given
10+
# $char in the given string $str and return the new string.
11+
#
12+
## Example 1
13+
##
14+
## Input: $str = "programming", $char = "g"
15+
## Output: "gorpramming"
16+
##
17+
## Reverse of prefix "prog" is "gorp".
18+
#
19+
#
20+
## Example 2
21+
##
22+
## Input: $str = "hello", $char = "h"
23+
## Output: "hello"
24+
#
25+
#
26+
## Example 3
27+
##
28+
## Input: $str = "abcdefghij", $char = "h"
29+
## Output: "hgfedcbaij"
30+
#
31+
#
32+
## Example 4
33+
##
34+
## Input: $str = "reverse", $char = "s"
35+
## Output: "srevere"
36+
#
37+
#
38+
## Example 5
39+
##
40+
## Input: $str = "perl", $char = "r"
41+
## Output: "repl"
42+
#
43+
############################################################
44+
##
45+
## discussion
46+
##
47+
############################################################
48+
#
49+
# This is a simple s/old/new/ thanks to perl's s///e feature.
50+
# We just need a regular expression that collects everything from
51+
# the beginning of the string up until the first appearance of $char.
52+
# The rest is applying reverse() to it which does exactly what we
53+
# need in scalar context.
54+
55+
use v5.36;
56+
57+
reverse_prefix("programming", "g");
58+
reverse_prefix("hello", "h");
59+
reverse_prefix("abcdefghij", "h");
60+
reverse_prefix("reverse", "s");
61+
reverse_prefix("perl", "r");
62+
63+
sub reverse_prefix($str, $char) {
64+
say "Input: '$str', '$char'";
65+
$str =~ s/^([^$char]*$char)/reverse($1)/e;
66+
say "Output: $str";
67+
}

‎challenge-341/mattneleigh/ch-1.pl‎ renamed to ‎challenge-341/mattneleigh/perl/ch-1.pl‎

File renamed without changes.

‎challenge-341/mattneleigh/ch-2.pl‎ renamed to ‎challenge-341/mattneleigh/perl/ch-2.pl‎

File renamed without changes.

0 commit comments

Comments
 (0)