Merge pull request #9230 from zapwai/branch-for-247

Week 247

2 files changed, 104 insertions, 0 deletions

diff --git a/challenge-247/zapwai/perl/ch-1.pl b/challenge-247/zapwai/perl/ch-1.pl
new file mode 100644
index 0000000000..40a1ce096e
--- /dev/null
+++ b/challenge-247/zapwai/perl/ch-1.pl
@@ -0,0 +1,80 @@
+use v5.30;
+use Algorithm::Permute;
+my @names = ('Mr. Wall',
+	     'Mrs. Wall',
+	     'Mr. Anwar',
+	     'Mrs. Anwar',
+	     'Mr. Conway',
+	     'Mr. Cross',
+	 );
+#@names = ('Mr. Wall', 'Mrs. Wall', 'Mr. Cringle');
+
+say "Input: \@names = (". join(", ", @names) . ")";
+say "Output: ";
+my @seq;
+my @tried;
+my $endflag = 1;
+my $N = factorial(scalar @names);
+my $index = int rand $N;
+my @P;
+load_perms();
+
+do {
+    @seq = random_pls($index);
+    if (check(@seq)) {
+	$endflag = 0;
+    } else {
+	$endflag++;
+	push @tried, $index;
+	my $test_string = join(" ", @tried);
+	my $flag = 0;
+	my $x;
+	do {
+	    $x = int rand $N;
+	    unless ( $test_string =~ m/$x/ ) {
+		$flag = 1;
+	    }
+	} until ($flag);
+	$index = $x;
+    }
+} until ( ($endflag == 0) or ($endflag == $N) );
+
+foreach my $i (0 .. $#seq - 1) {
+    print $names[$seq[$i]] . " --> ";
+}
+print $names[$seq[$#seq]]."\n";
+
+
+sub load_perms {
+    my $p = Algorithm::Permute->new([0 .. $#names]);
+    while (my @perm = $p->next) {
+	push @P, \@perm;
+    }
+}
+
+sub random_pls {
+    my $index = shift;
+    return @{$P[$index]};
+}
+
+sub factorial {
+    my ($n) = @_;
+    return 1 if $n == 0;
+    return factorial($n-1) * $n;
+}
+
+sub check {
+    my @seq = @_;
+    my @surname;
+    foreach my $name (@names) {
+	my @chunk = split(" ", $name);
+	push @surname, $chunk[1];
+    }
+    for my $i (0 .. $#seq - 1) {
+	if ($surname[$seq[$i]] eq $surname[$seq[$i + 1]]) {
+	    return 0;
+	}
+    }
+    return 0 if ($surname[$seq[0]] eq $surname[$seq[$#seq]]);
+    return 1;
+}
diff --git a/challenge-247/zapwai/perl/ch-2.pl b/challenge-247/zapwai/perl/ch-2.pl
new file mode 100644
index 0000000000..ff5f27ef6a
--- /dev/null
+++ b/challenge-247/zapwai/perl/ch-2.pl
@@ -0,0 +1,24 @@
+use v5.30;
+my $s = "abcdbca";
+my $s = "cdeabeabfcdfabgcd";
+my %h;
+my @pairs;
+my $max = 0;
+foreach my $i (0 .. (length $s) - 2) {
+    my $nom = substr $s, $i, 2;
+    $h{$nom}++;
+}
+foreach my $key (keys %h) {
+    if ($max < $h{$key}) {
+	$max = $h{$key};
+    }
+}
+foreach my $key (keys %h) {
+    push @pairs, $key if ($max == $h{$key});
+}
+my $ans = $pairs[0];
+foreach my $pair ( @pairs ) {
+    $ans = $pair if ($pair le $ans);
+}
+say "Input: \$s = $s";
+say "Output: $ans";