Merge pull request #11134 from pjcs00/wk294

Week 294 - Sequential permutations

3 files changed, 102 insertions, 0 deletions

diff --git a/challenge-294/peter-campbell-smith/blog.txt b/challenge-294/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..28966d70d8
--- /dev/null
+++ b/challenge-294/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+http://ccgi.campbellsmiths.force9.co.uk/challenge/294
diff --git a/challenge-294/peter-campbell-smith/perl/ch-1.pl b/challenge-294/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..b1e7daf620
--- /dev/null
+++ b/challenge-294/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-11-04
+use utf8;     # Week 294 - task 1 - Consecutive sequence
+use warnings; # Peter Campbell Smith
+binmode STDOUT, ':utf8';
+
+consecutive_sequence(0, 10, 1, 12, 14, 2, 4, 3, 1, 16);
+consecutive_sequence(10, 4, 20, 1, 3, 2);
+consecutive_sequence(10, 30, 20);
+consecutive_sequence(1000000, 1000001, 1000002, 42);
+consecutive_sequence(1, 2, 1, 2, 3, 1, 2, 3, 4, 1, 2, 3, 4, 5, 7);
+consecutive_sequence(1, 7, 3, 6, 2, 9, 11, 4);
+
+sub consecutive_sequence {
+	
+	my (@ints, @seen, $sequence, $best, $end, $j, $this, $run);
+	
+	# create $seen[$j] = 1 for all $j in @ints
+	@ints = @_;
+	$seen[$_] = 1 for @ints;
+	
+	# loop over %seen
+	$sequence = $best = 0;
+	$end = -1;
+	for $j (1 .. $#seen) {
+		unless (defined $seen[$j]) {
+			$sequence = 0;
+			next;
+		}
+			
+		# if consecutive elements of @seen exist, we have a sequence
+		if (defined $seen[$j - 1]) {
+			$sequence ++;
+			if ($sequence > $best) {
+				$best = $sequence;
+				$end = $j;
+			}
+		}
+	}
+	
+	# show results
+	$run .= qq[$_, ] for ($end - $best) .. $end;
+	say qq[\nInput:  \@ints = (] . join(', ', @ints) . ')';
+	say '' . ($end > 0) ?
+		sprintf ('%s %d: (%s)', 'Output:', $best + 1, substr($run, 0, -2)) :
+		qq[Output: -1];
+}
diff --git a/challenge-294/peter-campbell-smith/perl/ch-2.pl b/challenge-294/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..7fc8770d3d
--- /dev/null
+++ b/challenge-294/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+
+# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge
+
+use v5.26;    # The Weekly Challenge - 2024-11-04
+use utf8;     # Week 294 - task 2 - Next permutation
+use warnings; # Peter Campbell Smith
+use Algorithm::Combinatorics 'permutations';
+binmode STDOUT, ':utf8';
+
+next_permutation(1, 2, 3);
+next_permutation(2, 1, 3);
+next_permutation(3, 1, 2);
+next_permutation(1, 2, 4, 3);
+next_permutation(9, 11, 5, 3, 1);
+next_permutation(4, 3, 2, 1);
+
+my @ints;
+push @ints, int(rand(20)) for 0 .. 9;
+next_permutation(@ints);
+
+sub next_permutation {
+    
+    my (@ints, @sort_ints, $j, $iter, $next, $ok);
+    
+    # initialise
+	@ints = @_;
+	@sort_ints = sort { $a <=> $b } @ints;
+	
+	# if @ints is monotonically decreasing this is the last
+	$ok = 0;
+	for $j (1 .. $#ints) {
+		$ok |= 1 if $ints[$j - 1] < $ints[$j];
+	}	
+	
+    # get current permutation in lexicographic order
+	if ($ok) {
+		$iter = permutations(\@sort_ints);
+		ITER: while ($next = $iter->next) {
+			for $j (1 .. $#ints) {
+				next ITER unless $ints[$j] == $next->[$j];
+			}	
+			last ITER;
+		}
+		$next = $iter->next;   # the next iteration
+	}
+  
+    say qq[\nInput:  \@ints = (] . join(', ', @_) . ')';
+	say qq[Output:         ] . ($ok ? '(' . join(', ', @$next) . ')' :
+		'none: this is the last iteration');
+}