Week 237

2 files changed, 96 insertions, 0 deletions

diff --git a/challenge-237/zapwai/perl/ch-1.pl b/challenge-237/zapwai/perl/ch-1.pl
new file mode 100644
index 0000000000..f1d3d8ee3d
--- /dev/null
+++ b/challenge-237/zapwai/perl/ch-1.pl
@@ -0,0 +1,61 @@
+use v5.30;
+# Given yr, month, week, day (1 (Mon) .. 7 (Sun)), print date
+my ($year, $month, $week, $day) = (2024, 4, 3, 2);
+#my ($year, $month, $week, $day) = (2025, 10, 2, 4);
+#my ($year, $month, $week, $day) = (2026, 8, 5, 3);
+
+my @d = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+$d[1]++ if (is_leap($year));
+
+sub is_leap {
+    my $year = shift;
+    my $ans = 0;
+    unless ( $year % 100 == 0 ) {
+	$ans = 1 if ( $year % 4 == 0 );
+    }
+    $ans = 1 if ( $year % 400 == 0 );
+    return $ans;
+}
+
+sub start_day {
+    my $year = shift;
+    my @day = ('1', '2', '3', '4', '5', '6', '7');
+    my $steps = ($year - 1753) % 400;
+    my $cnt = 0;
+    unless ($steps == 0) {
+	for my $i (1 .. $steps) {
+	    $cnt = ($cnt + 1) % 7;
+	    $cnt = ($cnt + 1) % 7
+		if (is_leap(-1 + $year + $i - $steps));
+	}
+    }
+    return $day[$cnt];
+}
+
+sub month_start_day {
+    my ($year, $month) = @_;
+    my $start = start_day($year) - 1; # 0 to 6
+    my $cnt = $month - 1;
+    my $n = 0;
+    while ($cnt > 0) {
+	$cnt--;
+	$start += $d[$n];
+	$start %= 7;
+	$n++;
+    }
+    return (1 + $start);	
+}
+
+my $date = 1;
+my $start_day = month_start_day($year, $month);
+my $diff = $day - $start_day;
+my $n = $week - 1;
+$date += $diff;
+$date += $n * 7;
+$date += 7 if ($diff < 0);
+$date = 0 if ($date > $d[$month-1]);
+say "Input: (\$year, \$month, \$week, \$day) = ($year, $month, $week, $day)";
+say "Output: $date";
+if ($date == 0) {
+    say "\t(No such date.)";
+}
diff --git a/challenge-237/zapwai/perl/ch-2.pl b/challenge-237/zapwai/perl/ch-2.pl
new file mode 100644
index 0000000000..9f71d22ad5
--- /dev/null
+++ b/challenge-237/zapwai/perl/ch-2.pl
@@ -0,0 +1,35 @@
+use v5.30;
+my @nums = (1, 3, 5, 2, 1, 3, 1);
+say "Input: \@nums  = (" . join(", ",@nums) . ")";
+my %loc;
+for my $i (0 .. $#nums) {
+    if ($loc{$nums[$i]}) {
+	my @list = @{$loc{$nums[$i]}};
+	push @list, $i;
+	$loc{$nums[$i]} = \@list;
+    } else {
+	$loc{$nums[$i]} = [$i];
+    }
+}
+my @perm;
+my @tube = sort { $a <=> $b } @nums;
+my @value = reverse sort { $a <=> $b }  keys %loc;
+foreach my $i (@{$loc{$value[0]}}) {
+    $perm[$i] = shift @tube;
+}
+shift @value;
+for my $j (@value) {
+    foreach my $i (@{$loc{$j}}) {
+	if ($nums[$i] < $tube[$#tube]) {
+	    $perm[$i] = pop @tube;
+	}
+	else {
+	    $perm[$i] = shift @tube;	    
+	}
+    }
+}
+my $cnt;
+foreach my $i (0 .. $#nums) {
+    $cnt++ if ($nums[$i] < $perm[$i]);
+}
+say "Output: $cnt \n\t\t(".join(", ",@perm).")";