Week 307

2 files changed, 52 insertions, 0 deletions

diff --git a/challenge-307/zapwai/perl/ch-1.pl b/challenge-307/zapwai/perl/ch-1.pl
new file mode 100644
index 0000000000..2ff1dc4bf4
--- /dev/null
+++ b/challenge-307/zapwai/perl/ch-1.pl
@@ -0,0 +1,17 @@
+use v5.38;
+sub proc(@ints) {
+    say "Input: \@ints = @ints";
+    my @int = sort {$a <=> $b} @ints;
+    my @ind;
+
+    for my $i (0 .. $#ints) {
+	push @ind, $i if ($ints[$i] != $int[$i]);
+    }
+    say "Output: @ind";
+}
+my @ints = (5,2,4,3,1);
+proc(@ints);
+@ints = (1,2,1,1,3);
+proc(@ints);
+@ints = (3,1,3,2,3);
+proc(@ints);
diff --git a/challenge-307/zapwai/perl/ch-2.pl b/challenge-307/zapwai/perl/ch-2.pl
new file mode 100644
index 0000000000..ac8b4f396f
--- /dev/null
+++ b/challenge-307/zapwai/perl/ch-2.pl
@@ -0,0 +1,35 @@
+use v5.38;
+# return true if given words are anagrams
+sub is_anagram($w1, $w2) {
+    my @l1 = sort split "", $w1;
+    my @l2 = sort split "", $w2;
+    return 0 if (@l1 != @l2);
+    for my $i (0 .. $#l1) {
+	return 0 if ($l1[$i] ne $l2[$i]);
+    }
+    return 1;
+}
+sub proc(@words) {
+    say "Input: \@words = @words";
+    my $n;
+    do {
+	$n = 0;
+	my @ind;
+	for my $i (0 .. $#words - 1) {
+	    if (is_anagram($words[$i], $words[$i+1])) {
+		$n++;
+		push @ind, $i;
+		
+	    }
+	}
+	for (reverse @ind) {
+	    splice @words, $_, 1;
+	}
+    } while ($n);
+    say "Output: ". scalar @words . " (@words)";
+    
+}
+my @words = ("acca", "dog", "god", "perl", "repl");
+proc(@words);
+@words = ("abba", "baba", "aabb", "ab", "ab");
+proc(@words);