Week 335

2 files changed, 100 insertions, 0 deletions

diff --git a/challenge-335/zapwai/perl/ch-1.pl b/challenge-335/zapwai/perl/ch-1.pl
new file mode 100644
index 0000000000..43d8410a49
--- /dev/null
+++ b/challenge-335/zapwai/perl/ch-1.pl
@@ -0,0 +1,40 @@
+use v5.38;
+
+sub word_intersection($w1, $w2) {
+    my @l1 = sort split '', $w1;
+    my @l2 = sort split '', $w2;
+    my @o;
+    for my $i (0 .. $#l1) {
+	my $letter = $l1[$i];
+	for my $j (0 .. $#l2) {
+	    my $oletter = $l2[$j];
+	    if ($letter eq $oletter) {
+		push @o, $letter;
+		splice @l2, $j, 1;
+		last;
+	    }
+	}
+    }
+    return join '', @o;
+}
+
+sub proc(@words) {
+    say "Input : @words";
+    my $shared = $words[0];
+    for my $i (1 .. $#words) {
+	$shared = word_intersection($shared, $words[$i]);
+    }
+    say "Output: $shared";
+}
+
+my @words = ("bella", "label", "roller");
+proc(@words);
+
+@words = ("cool", "lock", "cook");
+proc(@words);
+@words = ("hello", "world", "pole");
+proc(@words);
+@words = ("abc", "def", "ghi");
+proc(@words);
+@words = ("aab", "aac", "aaa");
+proc(@words);
diff --git a/challenge-335/zapwai/perl/ch-2.pl b/challenge-335/zapwai/perl/ch-2.pl
new file mode 100644
index 0000000000..9620e5ef20
--- /dev/null
+++ b/challenge-335/zapwai/perl/ch-2.pl
@@ -0,0 +1,60 @@
+use v5.38;
+
+sub winner(@m) {
+    return "Pending" if (@m < 5);
+    my (@a, @b);
+    for my $i (0 .. $#m) {
+	if ($i % 2 == 0) {
+	    push @a, $m[$i];
+	} else {
+	    push @b, $m[$i];
+	}
+    }
+    my (@ax, @ay);
+    for (@a) {
+	push @ax, $$_[0];
+	push @ay, $$_[1];
+    }
+    my (@bx, @by);
+    for (@b) {
+	push @bx, $$_[0];
+	push @by, $$_[1];
+    }
+    my $win = "Draw";
+    if (
+	($ax[0] == $ax[1] && $ax[1] == $ax[2]) ||
+	($ay[0] == $ay[1] && $ay[1] == $ay[2]) ||
+	($ax[0] == $ay[0] && $ax[1] == $ay[1] && $ax[2] == $ay[2]) ||
+	($ax[0]+$ay[0] == 2 && $ax[1]+$ay[1] == 2 && $ax[2]+$ay[2] == 2)
+    ) {
+	$win = "A";
+    } elsif (
+	($bx[0] == $bx[1] && $bx[1] == $bx[2]) ||
+	($by[0] == $by[1] && $by[1] == $by[2]) ||
+	($bx[0] == $by[0] && $bx[1] == $by[1] && $bx[2] == $by[2]) ||
+	($bx[0]+$by[0] == 2 && $bx[1]+$by[1] == 2 && $bx[2]+$by[2] == 2)
+    ) {
+	$win = "B";
+    }
+    return $win;
+}
+
+sub proc(@m) {
+    print "Input: ( ";
+    foreach (@m) {
+	print "[", join(",", @$_), "] ";
+    }
+    say ")";
+    say "Output: ", winner(@m);
+}
+
+my @moves = ([0,0],[2,0],[1,1],[2,1],[2,2]);
+proc(@moves);
+@moves = ([0,0],[1,1],[0,1],[0,2],[1,0],[2,0]);
+proc(@moves);
+@moves = ([0,0],[1,1],[2,0],[1,0],[1,2],[2,1],[0,1],[0,2],[2,2]);
+proc(@moves);
+@moves = ([0,0],[1,1]);
+proc(@moves);
+@moves = ([1,1],[0,0],[2,2],[0,1],[1,0],[0,2]);
+proc(@moves);