1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
|
#! /opt/local/bin/perl
#
# kth_me_kate.pl
#
# TASK #1
# kth Permutation Sequence
# Write a script to accept two integers n (>=1) and k (>=1). It
# should print the kth permutation of n integers. For more
# information, please follow the wiki page.
#
# https://en.wikipedia.org/wiki/Permutation#k-permutations_of_n
#
# For example, n=3 and k=4, the possible permutation sequences are
# listed below:
#
# 123
# 132
# 213
# 231
# 312
# 321
# The script should print the 4th permutation sequence 231.
#
# notes on the question: So what exactly are we looking for here?
#
# Despite the wiki link given, which sends us to the subheading
# "#k-permutations_of_n", we do not appear to be looking to
# calculate here what is known as nPk, or the k-permutations of n,
# and so we will neither quantify, enumerate nor ruminate on any
# possible ordered groupings of k items selected from a set of n
# elements. That's a really interesting puzzle in its own right, but
# that does not jibe with the rest of the challenge description. We
# can only infer that the specific subheading portion of the link
# given is what as known as a red herring, or false lead, or perhaps
# wild goose chase.
#
# The rest of the page is informative reading, though, and holds
# clues as to the intent of the challenge. The first is a
# permutation is an expression of a particular rearrangement, or
# remapping, of a sequence; the verb rather than the noun.
#
# Thus the actual items being permuted are irrelevant, and as such
# when speaking of permutations it is common to use an ascending
# sequence of natural numbers, 1 2 3 4 5... as tokens representing
# the elements to be rearranged. So n here is the number of
# elements, which is what we expect, and the ordered start set will
# be of the form
#
# ( 1 2 3 ... n-2 n-1 n)
#
# The task seems to ask us to establish a list of all permutations
# of this ordered set and then locate and output the kth member of
# that list. The problem arises when one takes into account there is
# no one single way to sequence the order of possible permutations
# of a starting set. There are commonly accepted ways to label
# premutations with unique identifiers for later reference, but no
# one way to enumerate them. Mathematically it is the relationships
# between individual permutations that are interesting, rather than
# their positional information in a list.
#
# The list of n=3 in the task outline is sorted ascending as though
# the individual permutations were strings; "1 2 3" is followed by
# "1 3 2". This is known as lexicographic order, and is what we will
# assume is requested.
#
# The description also notably starts the list of permutaions with
# the identity permutation, the mapping of each element to its
# original place. So we need to make sure we start counting from
# there, rather than the first alteration. Remember, to choose to do
# nothing is still a choice.
#
#
# method: Now before we continue, let it be known that these days I'm
# not shooting for the fastest, most sensible nor efficiant
# methodology to go about solving these challenges. For instance,
# there exist some quite good modules in CPAN to make permutations
# simple, painless and fast. Of these I prefer and recommend
# Algorithm::Permute, it's written in XS and very good, albeit with
# some odd quirks. I even used it here previously for the wordgame
# challenge. No, these days I view these excursions as thought
# experiments and just prefer, if I have time, to explore the
# problem space and see whats there. Modules are an integral part of
# the Perl ecosystem but today I'm just going to have at it and roll
# my own. I have my own idiosyncratic rules for proceeding, and
# these rules are by no means fixed nor consistent.
#
# I suppose I'm drawing on an old artist technique in my toolbox, to
# artificially add constraints to a challenge. Combined with my
# apparent fascination with parsing the minutiae of the challenge
# questions, and you get a little slice of my brain. Welcome to my
# world, we have snacks.
#
# To obtain the kth lexicographically sorted permutation sequence
# the first approach was to generate a list of permutations and
# select the kth element of that list. Seems reasonable. So we use a
# recursive routine, constructing the patterns from left to right,
# and at each element iterate through the remaining numbers in the
# starting pattern in a well ordered way. The resulting list of
# patterns will come out lexicographically sorted. We can accomplish
# this by passing a set of remaining numbers, a working permutaion
# under construction, and a results set to hold the permutaions once
# finished.
#
# This is all well and good, and works fine for reletively small
# values of n, but as-is it needs to construct all of the patterns
# first and then select the kth member. Furthermore, it will
# obviously blow up with all that recursion and looping; even though
# the sets shrink by one element each time we proceed the time will
# still be n! to finish. We can improve this dramatically for
# smaller numbers of k by coupling in some reference slots to store
# the number requested and the the permutation produced, and
# short-circuiting to collapse the remaining recursion if we have
# our answer, but this is by no means a universal safeguard. The
# final routine is quite workable within reason, and is located in
#
# permute_recursive( \@set, \@working, $permutations, $data)
#
# There is of course a better way to do this, which is to rearrange
# the sequences in place, using an algorithm that only requires
# the current permutation to generate the next. One such algorithm
# is Knuth's Algoritm L (Lexicographic permutation generation),
# which he notes is only describing a method that had been invented
# some 600 years previous. This is implimented as
#
# compute_next_permutation( \@set )
#
# with a wrapper to apply it the correct number of times.
#
#
#
# 2020 colin crain
## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ##
use warnings;
use strict;
use feature ":5.26";
## ## ## ## ## MAIN:
my ( $number_elements, $sequence_requested ) = @ARGV ;
my $result = permute_with_recursion( $number_elements, $sequence_requested );
say "recursion: the " . $sequence_requested . "th permutation sequence is $result->@*";
my $result2 = permute_in_place( $number_elements, $sequence_requested );
say "in place : the " . $sequence_requested . "th permutation sequence is ", join ' ', $result2->@*;
## ## ## ## ## SUBS:
sub permute_with_recursion {
my ( $end, $selected_sequence ) = @_;
my @set = (1..$end);
my @working;
my $permutations = [];
my $data = { seq_number => $selected_sequence,
result => undef };
permute_recursive( \@set, \@working, $permutations, $data);
return $data->{result};
}
sub permute_recursive {
## given a starting set, a working list and a permutations set
## computes complete permutations as arrays and places the arrays on the permutations array
## which is maintained throughout by reference
my ($setref, $workref, $permutations, $data) = @_;
my @set = $setref->@*;
## if there is only one element left, push it on the working list,
## push that array reference onto the permutations array and return.
## This unique permutation list is complete.
if ( scalar @set == 1 ) {
my @working = $workref->@*;
push @working, $set[0];
if (scalar $permutations->@* == $data->{seq_number} - 1) {
$data->{result} = \@working;
}
else {
push $permutations->@*, \@working;
}
return;
}
## iterate through the remaining elements of the set,
## creating new copy of the working list, moving the element
## from the set to the working list and recursing with these
## new lists. The permutations list reference is passed through unchanged.
for my $element ( @set ) {
## collapse the recursion if we have our result
last if defined $data->{result};
my @working = $workref->@*;
push @working, $element;
my @subset = grep { $_ != $element } @set;
permute_recursive( \@subset, \@working, $permutations, $data );
}
}
sub permute_in_place {
my ( $end, $selected_sequence ) = @_;
my @set = (1..$end);
## the unrearranged sequence, the identity permutation,
## counts as sequence #1 as per the task
for (1..$selected_sequence-1) {
compute_next_permutation( \@set );
}
return \@set;
}
sub compute_next_permutation {
## in place algorithm (from Knuth Algorithm L, The Art of Computer Programming)
#
# «before we start we assume a sorted sequence a[0] <= a[1] <= ... <= a[n]»
# L1. «Visit» Take the given arrangement
# L2. «Find j» Find the largest index j such that a[j] < a[j + 1]. If no such index
# exists, terminate the algorithm and we are done
# L3. «Increase a[j]» Find the largest index k greater than j such that a[j] < a[k],
# L3a. then swap the values of a[j] and a[k].
# L4. «Reverse a[j+1]..a[n]» Reverse the subsequence starting at a[j + 1] through the end of the permutation,
# a[n]. Do nothing if j+1 >= n. Return to L1.
## L1
my $set = shift;
my $end = scalar $set->@* - 1;
## L2
my @one = grep { $set->[$_] < $set->[$_+1] } (0..$end-1);
my $j = $one[-1];
return if ! defined $j;
## L3
my @two = grep { $_ > $j and $set->[$_] > $set->[$j] } (0..$end);
my $k = $two[-1];
## L3a
($set->[$j], $set->[$k]) = ($set->[$k], $set->[$j]);
## L4
return unless ( $j+1 < $end ); # {
my @reversed = reverse($set->@[ ($j+1)..$end ]);
splice $set->@*, $j+1, $end-$j, @reversed;
}
|
